home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
prodpack.zip
/
DB4PPSRC.EXE
/
GENCODE.PRG
< prev
next >
Wrap
Text File
|
1993-05-25
|
153KB
|
5,648 lines
*' $Header: C:/test/ccppdbb/prgs/gencode.prv 1.0 06 May 1993 8:14:14 Bill Ramos $
PROCEDURE GenCode
PARAMETERS pcDbfDial
*----------------------------------------------------------------------------
* NAME
* GenCode - Create dialog program for DBF file
*
* DESCRIPTION
*
* PARAMETERS
* pcDbfDial = name of the dialog dbf file
*
*----------------------------------------------------------------------------
IF SET( "TALK" ) = "ON"
SET TALK OFF
lTalk = .T.
ELSE
lTalk = .F.
ENDIF
lSafety = SET( "SAFETY" ) = "ON"
SET SAFETY OFF
IF OpenFile( pcDbfDial )
gn_OdMax = 27
gn_OdCur = 0
gn_OdLeft = 0
gn_OdRight = 0
gc_OdText = [Generating dialog box: ] + pcDbfDial
gc_OdBoxCl = ""
DO _Odomet
ERASE ( pcDbfDial + ".win" )
ERASE ( pcDbfDial + ".dbo" )
SET CONSOLE OFF
nDlgDef = 0
STORE .F. TO bt, ef, cd, cs, cl, lb, ck, rb, ud
DO DefPublic
gn_OdCur = gn_OdCur + 1
DO _Odomet
DO GenStart && Used to be PROCEDURE DialDrvr
gn_OdCur = gn_OdCur + 1
DO _Odomet
DO GenDialS && PROCEDURE Dialog startup
gn_OdCur = gn_OdCur + 1
DO _Odomet
DO GenInitO && PROCEDURE Dialog Init objects
gn_OdCur = gn_OdCur + 1
DO _Odomet
DO GenDraw && PROCEDURE DrawDial
gn_OdCur = gn_OdCur + 1
DO _Odomet
DO GTstatic && PROCEDURE TStatic
gn_OdCur = gn_OdCur + 1
DO _Odomet
DO GHasTitle
gn_OdCur = gn_OdCur + 1
DO _Odomet
DO GGetMess
gn_OdCur = gn_OdCur + 1
DO _Odomet
IF bt .OR. ck .OR. rb
DO GGetWait
DO GTButton
ENDIF
gn_OdCur = gn_OdCur + 1
DO _Odomet
IF ef .OR. cs
DO GGetEdit
DO GTEdit
ENDIF
gn_OdCur = gn_OdCur + 1
DO _Odomet
IF lb .OR. cd .OR. cs .OR. cl
DO GTlist
DO GTabOut
IF cd .OR. cs .OR. cl
DO GTCombo
IF cd
DO GGetDD
ENDIF
IF cl
DO GGetDDL
ENDIF
ENDIF
ENDIF
gn_OdCur = gn_OdCur + 1
DO _Odomet
IF ud
DO GTUser
IF .NOT. (lb .OR. cd .OR. cs .OR. cl)
DO GTabOut
ENDIF
ENDIF
gn_OdCur = gn_OdCur + 1
DO _Odomet
DO GSetOnKey
gn_OdCur = gn_OdCur + 1
DO _Odomet
DO GClrOnKey
gn_OdCur = gn_OdCur + 1
DO _Odomet
DO GAKeyHand
gn_OdCur = gn_OdCur + 1
DO _Odomet
DO GCkWaitAc
gn_OdCur = gn_OdCur + 1
DO _Odomet
DO GGetMsTo
gn_OdCur = gn_OdCur + 1
DO _Odomet
DO GMsHand
gn_OdCur = gn_OdCur + 1
DO _Odomet
DO GDispatch
gn_OdCur = gn_OdCur + 1
DO _Odomet
DO GDisp
gn_OdCur = gn_OdCur + 1
DO _Odomet
DO GGetNext
gn_OdCur = gn_OdCur + 1
DO _Odomet
DO GWhenOk
gn_OdCur = gn_OdCur + 1
DO _Odomet
DO GGetId
gn_OdCur = gn_OdCur + 1
DO _Odomet
DO GPostVals
gn_OdCur = gn_OdCur + 1
DO _Odomet
DO GReleObjs
gn_OdCur = gn_OdCur + 1
DO _Odomet
DO GGenArray
gn_OdCur = gn_OdCur + 1
DO _Odomet
Do ClsFile
gn_OdCur = gn_OdCur + 1
DO _Odomet
COMPILE ( pcDbfDial )
gn_OdCur = gn_OdCur + 30
DO _Odomet
SET CONSOLE ON
ENDIF
IF lSafety
SET SAFETY ON
ENDIF
IF lTalk
SET TALK ON
ENDIF
RETURN
*-- EOP: GenCode WITH pcDbfDial
PROCEDURE DefPublic
*----------------------------------------------------------------------------
* NAME
* DefPublic -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
PUBLIC cClrDlg, cClrTit, cClrWBt, cClrBtA, cClrBtI, cClrBtD, cClrBtP, ;
cClrTxt, cClrStA, cClrStI, cClrStP, cClrGet, cClrCkI, cClrCkA, ;
cClrCkP, cClrLbIS, cClrLbR, cClrLbH, cClrLbI, cClrBtB, cClrBtN, ;
cClrCkN, cClrStN
cClrDlg = "n/w" && Default color of text for dialog
cClrTit = "w+/w" && Color of dialog title
cClrWBt = "g+/w" && Color of dialog window close button
cClrBtA = "w+/g" && Color of active button
cClrBtI = "n/g" && Color of inactive button
cClrBtD = "bg+/g" && Color of default button
cClrBtP = "gr+/g" && Color of button pick character
cClrBtB = "g/w" && Color of combo drop icon border
cClrBtN = "n+/g" && Color of dimmed button
cClrTxt = "n/w" && Color of plain text
cClrStA = "w+/w" && Color of active static text label
cClrStI = "n/w" && Color of inactive text label
cClrStP = "gr+/w" && Color of pick char for text label
cClrStN = "n+/w" && Color of dimmed text label
cClrGet = "w+/b" && Color of get field
cClrCkI = "n/gb" && Color of inactive check boxes
cClrCkA = "w+/gb" && Color of active check boxes
cClrCkN = "n+/gb" && Color of dimmed check box
cClrCkP = "gr+/gb" && Color of pick char of check box
cClrLbIS = "gr+/gb" && Color of inactive list box selection
cClrLbR = "n/gb" && Color of inactive rows in list box
cClrLbH = "w+/g" && Color of list box highlight
cClrLbI = "w/gb" && Color of list box message
PUBLIC mClrDlg, mClrTit, mClrWBt, mClrBtA, mClrBtI, mClrBtD, mClrBtP, ;
mClrTxt, mClrStA, mClrStI, mClrStP, mClrGet, mClrCkI, mClrCkA, ;
mClrCkP, mClrLbIS, mClrLbR, mClrLbH, mClrLbI, mClrBtB, mClrBtN, ;
mClrCkN, mClrStN
mClrDlg = "n/w" && Default color of text for dialog
mClrTit = "w+/w" && Color of dialog title
mClrWBt = "g+/w" && Color of dialog window close button
mClrBtA = "w+/g" && Color of active button
mClrBtI = "n/g" && Color of inactive button
mClrBtD = "bg+/g" && Color of default button
mClrBtP = "gr+/g" && Color of button pick character
mClrBtB = "g/w" && Color of combo drop icon border
mClrBtN = "n+/g" && Color of dimmed button
mClrTxt = "n/w" && Color of plain text
mClrStA = "w+/w" && Color of active static text label
mClrStI = "n/w" && Color of inactive text label
mClrStP = "gr+/w" && Color of pick char for text label
mClrStN = "n+/w" && Color of dimmed text label
mClrGet = "w+/b" && Color of get field
mClrCkI = "n/gb" && Color of inactive check boxes
mClrCkA = "w+/gb" && Color of active check boxes
mClrCkN = "n+/gb" && Color of dimmed check box
mClrCkP = "gr+/gb" && Color of pick char of check box
mClrLbIS = "gr+/gb" && Color of inactive list box selection
mClrLbR = "n/gb" && Color of inactive rows in list box
mClrLbH = "w+/g" && Color of list box highlight
mClrLbI = "w/gb" && Color of list box message
*--------------------------------------------------------------------------
*-- Define "global" constants. This will be a great #include later on
*--------------------------------------------------------------------------
PUBLIC WM_CREATE, WM_DESTROY, WM_ACTIVAT, WM_PAINT, WM_CLOSE, WM_NEXTDLGC
WM_CREATE = 1
WM_DESTROY = 2
WM_ACTIVAT = 6
WM_PAINT = 15 && Notification to repaint client area
WM_CLOSE = 16 && Note that user selected close button
WM_NEXTDLGC = 40 && Moves input focus to next control
&& in dialog box
&& wparam lparam
&& id .T. move focus
&& .F. .F. next control
&& .T. .F. prev control
PUBLIC SE_SHADOW
SE_SHADOW = -100
PUBLIC WM_DRAWITEM, WM_DELETEIT, WM_INITDIAL, WM_COMMAND, WM_SYSCOMM, SC_CLOSE
WM_DRAWITEM = 43 && Notification to the owner of an
&& owner drawn button, list..., that
&& the item has changed.
WM_DELETEIT = 45 && Note to parent of combo/list that
&& item was removed.
WM_INITDIAL = 272 && Note that dialog is going to display
WM_COMMAND = 273 && Notification that the user has
&& selected a menu item, control,
&& or accelerator key
WM_SYSCOMM = 274
SC_CLOSE = 61536
PUBLIC WM_LBDOWN, WM_LBUP, WM_CUT, WM_COPY, WM_PASTE, WM_CLEAR, WM_UNDO
WM_LBDOWN = 513
WM_LBUP = 514
WM_CUT = 768
WM_COPY = 769
WM_PASTE = 770
WM_CLEAR = 771
WM_UNDO = 772
*-- Dialog box default buttons to exit dialog
PUBLIC DLN_OK, DLN_CANCEL, DLN_HELP
DLN_OK = -500
DLN_CANCEL = -501
DLN_HELP = -502
*-- Button Control Messages
PUBLIC BM_GETCHECK, BM_SETCHECK, BM_GETSTATE, BM_SETSTATE, BM_SETSTYLE
BM_GETCHECK = 0
BM_SETCHECK = 1
BM_GETSTATE = 2
BM_SETSTATE = 3
BM_SETSTYLE = 4
*-- Button Control Styles (low word)
PUBLIC BS_PUSHBUTT, BS_DEFPUSHB, BS_CHECKBOX, BS_AUTOCHEC, BS_RADIOBUT
PUBLIC BS_3STATE, BS_AUTO3STA, BS_GROUPBOX, BS_USERBUTT, BS_AUTORADI
PUBLIC BS_OWNERDRA, BS_LEFTTEXT
BS_PUSHBUTT = 0
BS_DEFPUSHB = 1
BS_CHECKBOX = 2
BS_AUTOCHEC = 3
BS_RADIOBUT = 4
BS_3STATE = 5
BS_AUTO3STA = 6
BS_GROUPBOX = 7
BS_USERBUTT = 8
BS_AUTORADI = 9
BS_OWNERDRA = 12
BS_LEFTTEXT = 32
*-- User Button Notification Codes
PUBLIC BN_CLICKED, BN_PAINT, BN_HILITE, BN_UNHILITE, BN_DISABLE, ;
BN_DOUBLECL, BN_DEFAULT, BN_COLOR
PUBLIC BN_PRESSED
BN_CLICKED = 0
BN_PAINT = 1
BN_HILITE = 2
BN_UNHILITE = 3
BN_DISABLE = 4
BN_DOUBLECL = 5
BN_DEFAULT = 6
BN_PRESSED = 7
BN_COLOR = 8
*-- Combo Box Notification Codes
PUBLIC CBN_ERRSPAC, CBN_SELCHAN, CBN_DBLCLK, CBN_SETFOCU, CBN_KILLFOC, ;
CBN_EDITCHA, CBN_EDITUPD, CBN_DROPDOW, CBN_INLIST
CBN_ERRSPAC = (-1)
CBN_SELCHAN = 1
CBN_DBLCLK = 2
CBN_SETFOCU = 3
CBN_KILLFOC = 4
CBN_EDITCHA = 5
CBN_EDITUPD = 6
CBN_DROPDOW = 7
CBN_INLIST = 8
*-- Combo Box styles (low words)
PUBLIC CBS_SIMPLE, CBS_DROPD, CBS_DROPDL
CBS_SIMPLE = 1
CBS_DROPD = 2
CBS_DROPDL = 3
*-- Combo Box messages
PUBLIC CB_GETEDIT, CB_LIMITTE, CB_SETEDIT, CB_ADDSTRI, CB_DELETES, CB_DIR, ;
CB_GETCOUN, CB_GETCURS, CB_GETLBT, CB_GETLBTL, CB_INSERTS , ;
CB_RESETCO, CB_FINDSTR, CB_SELECTS, CB_SETCURS, CB_SHOWDRO, ;
CB_GETITDA, CB_SETITDA, CB_GETDRCR, CB_SETITHE, CB_GETEXTE, ;
CB_GETDRST, CB_FINDSTR, CB_HIDELST
CB_GETEDIT = 0
CB_LIMITTE = 1
CB_SETEDIT = 2
CB_ADDSTRI = 3
CB_DELETES = 4
CB_DIR = 5
CB_GETCOUN = 6
CB_GETCURS = 7
CB_GETLBT = 8
CB_GETLBTL = 9
CB_INSERTS = 10
CB_RESETCO = 11
CB_FINDSTR = 12
CB_SELECTS = 13
CB_SETCURS = 14
CB_SHOWDRO = 15
CB_GETITDA = 16
CB_SETITDA = 17
CB_GETDRCR = 18
CB_SETITHE = 19
CB_GETEXTE = 22
CB_GETDRST = 23
CB_FINDSTR = 24
CB_HIDELST = 25
*-- Dialog box messages
PUBLIC DM_GETDID, DM_SETDID
DM_GETDID = 0 && Return ID of default pushbutton
DM_SETDID = 1 && Change ID of default pushbutton
*-- Listbox messages
PUBLIC LB_ADDSTRI, LB_INSERTS, LB_DELETES, LB_RESETCO, LB_SETSEL, LB_SETCURS, ;
LB_GETSEL, LB_GETCURS, LB_GETTEXT, LB_GETTEXT, LB_GETCOUN, LB_SELECTS, ;
LB_DIR, LB_GETTOPI, LB_FINDSTR, LB_GETSELC, LB_GETSELI, LB_SETTABS, ;
LB_GETHORI, LB_SETHORI, LB_SETTOPI, LB_GETITRE, LB_GETITDA, LB_SETITDA, ;
LB_SELITRA, LB_SETCARE, LB_GETCARE, LB_SETITHE, LB_GETITHE, LB_FINDSTR
LB_ADDSTRI = 1
LB_INSERTS = 2
LB_DELETES = 3
LB_RESETCO = 5
LB_SETSEL = 6
LB_SETCURS = 7
LB_GETSEL = 8
LB_GETCURS = 9
LB_GETTEXT = 10
LB_GETTEXT = 11
LB_GETCOUN = 12
LB_SELECTS = 13
LB_DIR = 14
LB_GETTOPI = 15
LB_FINDSTR = 16
LB_GETSELC = 17
LB_GETSELI = 18
LB_SETTABS = 19
LB_GETHORI = 20
LB_SETHORI = 21
LB_SETTOPI = 24
LB_GETITRE = 25
LB_GETITDA = 26
LB_SETITDA = 27
LB_SELITRA = 28
LB_SETCARE = 31
LB_GETCARE = 32
LB_SETITHE = 33
LB_GETITHE = 34
LB_FINDSTR = 35
*-- Listbox Notification Codes
PUBLIC LBN_ERRSPA, LBN_SELCHA, LBN_DBLCLK, LBN_SELCAN, LBN_SETFOC, LBN_KILLFO
LBN_ERRSPA = (-2)
LBN_SELCHA = 1
LBN_DBLCLK = 2
LBN_SELCAN = 3
LBN_SETFOC = 4
LBN_KILLFO = 5
*-- Edit Control Messages
PUBLIC EM_GETSEL, EM_SETSEL, EM_GETRE, EM_SETRE, EM_SETRENP, EM_GETMODI
PUBLIC EM_SETMODI, EM_SETHAND, EM_GETHAND, EM_LINELEN, EM_REPLACE, EM_GETLINE
PUBLIC EM_CANUNDO, EM_UNDO, EM_EMPTYUN, EM_SETREAD
EM_GETSEL = 0
EM_SETSEL = 1
EM_GETRE = 2
EM_SETRE = 3
EM_SETRENP = 4
EM_GETMODI = 8
EM_SETMODI = 9
EM_SETHAND = 12
EM_GETHAND = 13
EM_LINELEN = 17
EM_REPLACE = 18
EM_GETLINE = 20
EM_CANUNDO = 22
EM_UNDO = 23
EM_EMPTYUN = 29
EM_SETREAD = 31
*-- Edit Control Notification Codes
PUBLIC EN_SETFOCU, EN_KILLFOC, EN_CHANGE, EN_UPDATE, EN_ERRSPAC
EN_SETFOCU = 1
EN_KILLFOC = 2
EN_CHANGE = 3
EN_UPDATE = 4
EN_ERRSPAC = 5
*-- Common Keyboard from INKEY and LASTKEY functions
PUBLIC KB_TAB, KB_ENTER, KB_SPACE, KB_SHIFTTAB, KB_UPARROW, KB_DOWNARROW, ;
KB_LEFTARROW, KB_RTARROW, KB_F1, KB_ESC, KB_MOUSE, KB_CTRLW
KB_TAB = 9
KB_ENTER = 13
KB_SPACE = 32
KB_SHIFTTAB = -400
KB_UPARROW = 5
KB_DOWNARROW = 24
KB_LEFTARROW = 19
KB_RTARROW = 4
KB_F1 = 28
KB_ESC = 27
KB_MOUSE = -100
KB_CTRLW = 23
RETURN
*-- EOP: DefPublic
FUNCTION OpenFile
PARAMETERS pcDbfDial
*----------------------------------------------------------------------------
* NAME
* OpenFile() -
*
* DESCRIPTION
*
* PARAMETERS
* pcDbfDial =
*
*----------------------------------------------------------------------------
lOk = .T.
IF ALIAS() = pcDbfDial
IF FILE( pcDbfDial + ".PRG" )
lh = 0
lh = FOPEN( pcDbfDial + ".PRG", "r" )
IF lh > 0
cLine = FGETS( lh )
IF FCLOSE( lh )
ENDIF
IF LEFT( cLine, 7 ) <> "*-- DBW"
IF _NodShake( " ; File already exists, overwrite? " + ;
pcDbfDial + ".PRG ", 9, 15, 2, 50, .T. )
ERASE ( pcDbfDial + ".PRG" )
ELSE
lOk = .F.
DO _Err_Box WITH "Code generation cancelled"
ENDIF
ELSE
ERASE ( pcDbfDial + ".PRG" )
ENDIF
ELSE
lOk = .F.
DO _Err_Box WITH [File in use by another: ] + pcDbfDial + ".PRG"
ENDIF
ENDIF
IF lOk
SET CONSOLE OFF
SET ALTERNATE TO ( pcDbfDial + ".PRG" )
_pcolno = 0
SET ALTERNATE ON
?? '*-- DBW - Dialog Box Workshop -' AT 0, pcDbfDial + ".PRG"
?
ENDIF
ELSE
DO _Err_Box WITH [Dialog DBF file does not exist]
lOk = .F.
ENDIF
RETURN lOk
*-- EOF: OpenFile( pcDbfDial )
PROCEDURE ClsFile
*----------------------------------------------------------------------------
* NAME
* ClsFile -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
SET ALTERNATE OFF
SET ALTERNATE TO
CLOSE DATABASE
RELEASE cClrDlg, cClrTit, cClrWBt, cClrBtA, cClrBtI, cClrBtD, cClrBtP, ;
cClrTxt, cClrStA, cClrStI, cClrStP, cClrGet, cClrCkI, cClrCkA, ;
cClrCkP, cClrLbIS, cClrLbR, cClrLbH, cClrLbI, cClrBtB, cClrBtN, ;
cClrCkN, cClrStN
RELEASE WM_CREATE, WM_DESTROY, WM_ACTIVAT, WM_PAINT, WM_CLOSE, WM_NEXTDLGC
RELEASE SE_SHADOW
RELEASE WM_DRAWITEM, WM_DELETEIT, WM_INITDIAL, WM_COMMAND, WM_SYSCOMM, SC_CLOSE
RELEASE WM_LBDOWN, WM_LBUP, WM_CUT, WM_COPY, WM_PASTE, WM_CLEAR, WM_UNDO
RELEASE DLN_OK, DLN_CANCEL, DLN_HELP
RELEASE BM_GETCHECK, BM_SETCHECK, BM_GETSTATE, BM_SETSTATE, BM_SETSTYLE
RELEASE BS_PUSHBUTT, BS_DEFPUSHB, BS_CHECKBOX, BS_AUTOCHEC, BS_RADIOBUT
RELEASE BS_3STATE, BS_AUTO3STA, BS_GROUPBOX, BS_USERBUTT, BS_AUTORADI
RELEASE BS_OWNERDRA, BS_LEFTTEXT
RELEASE BN_CLICKED, BN_PAINT, BN_HILITE, BN_UNHILITE, BN_DISABLE, ;
BN_DOUBLECL, BN_DEFAULT, BN_COLOR
RELEASE BN_PRESSED
RELEASE CBN_ERRSPAC, CBN_SELCHAN, CBN_DBLCLK, CBN_SETFOCU, CBN_KILLFOC, ;
CBN_EDITCHA, CBN_EDITUPD, CBN_DROPDOW, CBN_INLIST
RELEASE CBS_SIMPLE, CBS_DROPD, CBS_DROPDL
RELEASE CB_GETEDIT, CB_LIMITTE, CB_SETEDIT, CB_ADDSTRI, CB_DELETES, CB_DIR, ;
CB_GETCOUN, CB_GETCURS, CB_GETLBT, CB_GETLBTL, CB_INSERTS , ;
CB_RESETCO, CB_FINDSTR, CB_SELECTS, CB_SETCURS, CB_SHOWDRO, ;
CB_GETITDA, CB_SETITDA, CB_GETDRCR, CB_SETITHE, CB_GETEXTE, ;
CB_GETDRST, CB_FINDSTR, CB_HIDELST
RELEASE DM_GETDID, DM_SETDID
RELEASE LB_ADDSTRI, LB_INSERTS, LB_DELETES, LB_RESETCO, LB_SETSEL, LB_SETCURS, ;
LB_GETSEL, LB_GETCURS, LB_GETTEXT, LB_GETTEXT, LB_GETCOUN, LB_SELECTS, ;
LB_DIR, LB_GETTOPI, LB_FINDSTR, LB_GETSELC, LB_GETSELI, LB_SETTABS, ;
LB_GETHORI, LB_SETHORI, LB_SETTOPI, LB_GETITRE, LB_GETITDA, LB_SETITDA, ;
LB_SELITRA, LB_SETCARE, LB_GETCARE, LB_SETITHE, LB_GETITHE, LB_FINDSTR
RELEASE LBN_ERRSPA, LBN_SELCHA, LBN_DBLCLK, LBN_SELCAN, LBN_SETFOC, LBN_KILLFO
RELEASE EM_GETSEL, EM_SETSEL, EM_GETRE, EM_SETRE, EM_SETRENP, EM_GETMODI
RELEASE EM_SETMODI, EM_SETHAND, EM_GETHAND, EM_LINELEN, EM_REPLACE, EM_GETLINE
RELEASE EM_CANUNDO, EM_UNDO, EM_EMPTYUN, EM_SETREAD
RELEASE EN_SETFOCU, EN_KILLFOC, EN_CHANGE, EN_UPDATE, EN_ERRSPAC
RELEASE KB_TAB, KB_ENTER, KB_SPACE, KB_SHIFTTAB, KB_UPARROW, KB_DOWNARROW, ;
KB_LEFTARROW, KB_RTARROW, KB_F1, KB_ESC, KB_MOUSE, KB_CTRLW
RETURN
*-- EOP: ClsFile
PROCEDURE GenStart
*----------------------------------------------------------------------------
* NAME
* GenStart - Generate startup code for the dialog
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
_pcolno = 0
?? "PROCEDURE " + pcDbfDial
TEXT
*----------------------------------------------------------------------------
* NAME
* DESCRIPTION
*----------------------------------------------------------------------------
PRIVATE cAlias, cWindow, lTalk, lSafety, cDialog, cHelpFile, cStartLib
IF SET( "TALK" ) = "ON"
SET TALK OFF
lTalk = .T.
ELSE
lTalk = .F.
ENDIF
lSafety = SET( "SAFETY" ) = "ON"
SET SAFETY OFF
cWindow = WINDOW()
cAlias = ALIAS()
*----------------------------------
*-- Setup the help system variables
*----------------------------------
lError = .F.
ENDTEXT
*-----------------------------------
*-- Generate the help file reference
*-----------------------------------
IF TYPE( "DBW_HELP" ) = "C" .AND. .NOT. ISBLANK( DBW_HELP )
? ' cHelpFile = "' + UPPER( TRIM( DBW_HELP ) ) + '"'
ELSE
? ' cHelpFile = "' + UPPER( TRIM( pcDbfDial ) ) + '"'
ENDIF
? ' cDialog = "' + UPPER( TRIM( pcDbfDial ) ) + '"'
cDir = UPPER( GETENV( "MTGROUP" ) )
IF cDir = "CCPPMFFU"
cLibName = "MFFULIB"
ELSE
cLibName = "DBBLIB"
ENDIF
? ' cDBBLib = "' + cLibName + '"'
TEXT
*----------------------------------------------
*-- Setup the link to the DBB Procedure Library
*----------------------------------------------
ON ERROR lError = .T.
cStartLib = SET( "PROCEDURE" )
SET PROCEDURE TO ( cDBBLib )
IF lError
lError = .F.
SET PROCEDURE TO HOME() + cDBBLib
IF lError
*-- Display the error message in a windowed box
PRIVATE lc_anykey, lc_msg, lc_msglen, lc_win, ln_press, ln_width, ll_trap,;
ll_escape
lc_anykey = [Press any key to continue...]
ln_press = LEN( lc_anykey )
lc_msg = [Could not locate procedure file: ] + cDBBLib
ln_msglen = LEN( lc_msg )
ln_width = 0
ll_escape = SET("ESCAPE") = "ON"
SET ESCAPE OFF
*-- Determine the width needed for the window:
IF ln_msglen <= ln_press
ln_width = ln_press
ELSE
*-- Make sure the message fits in the window:
IF ln_msglen > 76
lc_msg = LEFT( lc_msg, 76 )
ln_msglen = 76
ENDIF
ln_width = ln_msglen
ENDIF
DEFINE WINDOW _err_box FROM 9, ((76 - ln_width) + .5) / 2 ;
TO 15, (ln_width + 83) / 2 DOUBLE
ln_width = ( ln_width + 2 )
*-- Display the message and prompt to the window and wait for a key press
ACTIVATE WINDOW _err_box
? lc_msg AT ( ln_width - ln_msglen ) / 2
?
? lc_anykey AT ( ln_width - ln_press ) / 2
SET CONSOLE OFF
WAIT
SET CONSOLE ON
*-- Clean up the window display and reactivate the previous window
RELEASE WINDOW _err_box
IF ll_escape
SET ESCAPE ON
ELSE
SET ESCAPE OFF
ENDIF
ENDIF
ENDIF
ON ERROR
*---------------------------------
*-- Run the actual dialog box code
*---------------------------------
IF .NOT. lError
DO Dialog
ENDIF
*----------------------------------
*-- Restore the startup environment
*----------------------------------
IF .NOT. ISBLANK( cStartLib )
SET PROCEDURE TO ( cStartLib )
ENDIF
IF .NOT. ISBLANK( cAlias ) .AND. SELECT( cAlias ) > 0
SELECT ( cAlias )
ENDIF
IF lSafety
SET SAFETY ON
ENDIF
IF lTalk
SET TALK ON
ENDIF
IF .NOT. ISBLANK( cWindow )
ACTIVATE WINDOW &cWindow
ENDIF
RETURN
ENDTEXT
? "*-- EOP: " + pcDbfDial
?
?
RETURN
*-- EOP: GenStart
PROCEDURE GenDialS
*----------------------------------------------------------------------------
* NAME
* GenDialS - Generate dialog box setup code.
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
TEXT
PROCEDURE Dialog
*----------------------------------------------------------------------------
* NAME
* Dialog -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
*---------------------------------------
*-- Temporary for now, message varaibles
*---------------------------------------
DLN_OK = -500
DLN_CANCEL = -501
DLN_HELP = -502
WM_PAINT = 15 && Notification to repaint client area
WM_CLOSE = 16 && Note that user selected close button
WM_DRAWITEM = 43 && Notification to the owner of an
BN_CLICKED = 0
BN_PAINT = 1
BN_HILITE = 2
BN_UNHILITE = 3
BN_DISABLE = 4
BN_DEFAULT = 6
BN_PRESSED = 7
BN_COLOR = 8
SE_SHADOW = -100
EN_SETFOCU = 1
EN_KILLFOC = 2
CB_SELECTS = 13
CB_SHOWDRO = 15
CB_HIDELST = 25
CBN_SELCHAN = 1
CBN_DBLCLK = 2
CBN_SETFOCU = 3
CBN_KILLFOC = 4
CBN_EDITCHA = 5
CBN_EDITUPD = 6
CBN_DROPDOW = 7
CBN_INLIST = 8
LBN_SELCHA = 1
LBN_DBLCLK = 2
LBN_SELCAN = 3
LBN_SETFOC = 4
LBN_KILLFO = 5
KB_TAB = 9
KB_ENTER = 13
KB_SPACE = 32
KB_SHIFTTAB = -400
KB_UPARROW = 5
KB_DOWNARROW = 24
KB_LEFTARROW = 19
KB_RTARROW = 4
KB_F1 = 28
KB_ESC = 27
KB_MOUSE = -100
KB_CTRLW = 23
*--------------------
*-- Working variables
*--------------------
PRIVATE nCurrent, nCurrGrp, lButtAct, nMRow, nMCol, nMsEvent, nDlgDef, nAccel
PRIVATE n1stGrp, nCancelBt
nCurrent = 0 && Current dialog object id
nCurrGrp = 0 && Current group id for object id
lButtAct = .F. && Dialog has a button active
nMRow = -1
nMCol = -1
nMsEvent = 0
nDlgDef = 0
nAccel = 0
n1stGrp = 0
nCancelBt = 0 && Id for cancel button
PRIVATE nDefButt, nMess
nDefButt = 0 && Number of object with default button
nMess = 0
PRIVATE cOldFClr, cOldBClr, cOldHClr, cOldMClr, cOldNClr, cOldTClr
cOldFClr = _ColorChk( "F" )
cOldBClr = _ColorChk( "B" )
cOldHClr = _ColorChk( "H" )
cOldMClr = _ColorChk( "M" )
cOldNClr = _ColorChk( "N" )
cOldTClr = _ColorChk( "T" )
ENDTEXT
?
? " SET COLOR OF FIELDS TO " + cClrGet
? " SET COLOR OF BOX TO " + cClrLbR
? " SET COLOR OF HIGH TO " + cClrLbH
? " SET COLOR OF MESS TO " + cClrLbR
? " SET COLOR OF TITLE TO " + cClrLbR
TEXT
*------------------------
*-- Close Icon for window
*------------------------
PRIVATE nRowCls, nOrigRow, nOrigCol, nXoffset, nYOffset, nCol, ;
nHigh, nWidth, nLColCls, nRColCls, nRWinCol, cField, cClass, nScreen
cField = ""
cClass = ""
ENDTEXT
SET FILTER TO
SET ORDER TO
GO TOP
? ' nRowCls =', TSTR( row )
? ' nOrigRow =', TSTR( row )
? ' nOrigCol =', TSTR( col )
? ' nXOffset = 0'
? ' nYOffset = 0'
? ' nCol =', TSTR( col )
nCol = col
? ' nHigh =', TSTR( decimals )
? ' nWidth =', TSTR( length )
nWidth = length
? ' nLColCls =', TSTR( ncol + 2 )
? ' nRColCls =', TSTR( ncol + 4 )
? ' nRWinCol =', TSTR( ncol + nWidth - 1 )
TEXT
nScreen = IIF( "50" $ SET("DISPLAY"), 49, ;
IIF( "43" $ SET("DISPLAY"), 42, 24 ) )
IF SET( "STATUS" ) = "ON"
nScreen = nScreen - 3
ENDIF
PRIVATE nClkBox, nClkObj, aClkBox, aClkObj, aObjPoint
*--------------------------------------------------
*-- Get the number of clickable boxes in the dialog
*--------------------------------------------------
ENDTEXT
COUNT FOR value_type = "B" .AND. LEFT( fieldname, 3 ) $ "CS_,LB_,UD_" ;
TO nClkBox
? ' nClkBox =', TSTR( nClkBox )
IF nClkBox > 0
? " DECLARE aClkBox[", LTRIM( STR( nClkBox ) ), ", 6 ]"
i = 1
SCAN FOR value_type = "B" .AND. LEFT( fieldname, 3 ) $ "CS_,LB_,UD_"
? " aClkBox[", LTRIM( STR( i ) ), ", 1 ] =", TSTR( row ), ;
" " AT 38,"&"+"& " + fieldname
? " aClkBox[", LTRIM( STR( i ) ), ", 2 ] =", TSTR( decimals )
? " aClkBox[", LTRIM( STR( i ) ), ", 3 ] =", TSTR( col )
? " aClkBox[", LTRIM( STR( i ) ), ", 4 ] =", TSTR( length )
? " aClkBox[", LTRIM( STR( i ) ), ", 5 ] =", TSTR( RECNO() )
? " aClkBox[", LTRIM( STR( i ) ), ", 6 ] = .F."
?? '&'+'& Clink in the box flag' AT 41
i = i + 1
ENDSCAN
ENDIF
TEXT
*--------------------------------------------------
*-- Get the number of clickable items in the dialog
*--------------------------------------------------
ENDTEXT
COUNT FOR currentid > 0 ;
TO nClkObj
? ' nClkObj =', TSTR( nClkObj )
IF nClkObj > 0
SET ORDER TO ObjOrder
? " DECLARE aClkObj[", LTRIM( STR( nClkObj ) ), ", 13 ]"
i = 1
SCAN FOR currentid > 0
? " aClkObj[", LTRIM( STR( i ) ), ", 1 ] =", TSTR( row ) , ;
" " AT 38, "&"+"& Row"
? " aClkObj[", LTRIM( STR( i ) ), ", 2 ] =", TSTR( col ), ;
" " AT 38, "&"+"& Col"
? " aClkObj[", LTRIM( STR( i ) ), ", 3 ] =", TSTR( decimals ), ;
" " AT 38, "&"+"& Decimals"
? " aClkObj[", LTRIM( STR( i ) ), ", 4 ] =", TSTR( RECNO() ), ;
" " AT 38, "&"+"& CurrentId"
? " aClkObj[", LTRIM( STR( i ) ), ", 5 ] =", TSTR( groupid ), ;
" " AT 38, "&"+"& GroupId"
? " aClkObj[", LTRIM( STR( i ) ), ", 6 ] =", TSTR( nextid ), ;
" " AT 38, "&"+"& NextId"
? " aClkObj[", LTRIM( STR( i ) ), ", 7 ] =", TSTR( previd ), ;
" " AT 38, "&"+"& PrevId"
? " aClkObj[", LTRIM( STR( i ) ), ", 8 ] =", STR2QT( pickkey ), ;
" " AT 38, "&"+"& PickKey"
*-------------------------------------------------------
*-- Get the next and previous object id within the group
*-------------------------------------------------------
IF .NOT. LEFT( fieldname, 3 ) $ "RB_,CK_,EF_"
nPrevGroup = currentid
nNextGroup = currentid
ELSE
nSaveRec = RECNO()
nThisGroup = groupid
SET FILTER TO groupid = nThisGroup .AND. ;
RIGHT( TRIM( fieldname ), 2 ) <> "_0"
SKIP
IF .NOT. EOF()
nNextGroup = currentid
ELSE
GO TOP
nNextGroup = currentid
ENDIF
GOTO nSaveRec
SKIP - 1
IF .NOT. BOF()
nPrevGroup = currentid
ELSE
GO BOTTOM
nPrevGroup = currentid
ENDIF
GOTO nSaveRec
SET FILTER TO
ENDIF
? " aClkObj[", LTRIM( STR( i ) ), ", 9 ] =", TSTR( nPrevGroup ), ;
" " AT 38, "&"+"& Previous item in group"
? " aClkObj[", LTRIM( STR( i ) ), ",10 ] =", TSTR( nNextGroup ), ;
" " AT 38, "&"+"& Next item in group"
? ' aClkObj[', LTRIM( STR( i ) ), ',11 ] = "' + TRIM( fieldname ) + '"'
?? "&"+"& " + TRIM(Template) AT 41
? ' aClkObj[', LTRIM( STR( i ) ), ',12 ] = [' + TRIM( hlp_msg ) + ']'
? ' aClkObj[', LTRIM( STR( i ) ), ',13 ] = [' + TRIM( rej_msg ) + ']'
?
IF TRIM( fieldname ) = 'BT_CANCEL'
? ' nCancelBt =', TSTR( RECNO() )
?
ENDIF
i = i + 1
ENDSCAN
ENDIF
TEXT
*-------------------------------------------------------------
*-- Setup object pointers in to the current object array above
*-------------------------------------------------------------
ENDTEXT
SET ORDER TO ObjOrder
? ' DECLARE aObjPoint[', TSTR( RECCOUNT() ), ']'
i = 1
SCAN FOR currentid > 0
? ' aObjPoint[', TSTR( RECNO() ), '] =', TSTR( i )
i = i + 1
ENDSCAN
TEXT
*-------------------------------------------------------------------
*-- Setup private memory variables for object states (from InitObjs)
*-- First variable with the object memvar name contains the value
*-- for the object. The second varaible, if present, indicates
*-- the id of the object previously active in the group.
*-------------------------------------------------------------------
ENDTEXT
SET FILTER TO
SCAN FOR currentid > 0
cField = TRIM( fieldname )
? " PRIVATE", LOWER( cField )
? " ", LOWER( fieldname ), ' = ""'
cClass = LEFT( cField, 3 )
IF cClass $ "CK_,RB_,LB_,UD_,CS_,CL_,CD_" .AND. RIGHT( cField, 2 ) = "_1"
cVar = "n" + _Proper( LEFT( cField, RAT( "_", cField ) - 1 ) )
? " PRIVATE", cvar
IF cClass $ "LB_,CS_,CL_,CD_,UD_"
? " ", cvar, "= 0"
ELSE
? " ", cvar, "=", TSTR( RECNO() )
ENDIF
ENDIF
ENDSCAN
TEXT
DO InitObjs
DO DrawDial && Draw all the dialog objects
*--------------------------------
*-- Set focus to the first object
*--------------------------------
DO GetNext WITH nCurrent, .T.
*-- The message loop
nMess = 0
DO WHILE .NOT. GetMess()
DO Dispatch
IF nMess = DLN_OK .OR. nMess = DLN_CANCEL
EXIT
ENDIF
ENDDO
IF nMess = DLN_OK
DO PostVals
FXL_Cancel = .F.
ELSE
FXL_Cancel = .T.
ENDIF
ENDTEXT
? ' RELEASE WINDOW', pcDbfDial
? ' RESTORE SCREEN FROM', pcDbfDial
? ' RELEASE SCREEN', pcDbfDial
TEXT
DO ReleObjs
SET COLOR OF FIELDS TO &cOldFClr
SET COLOR OF BOX TO &cOldBClr
SET COLOR OF HIGH TO &cOldHClr
SET COLOR OF MESS TO &cOldMClr
SET COLOR OF TITLE TO &cOldTClr
SET CURSOR ON
RETURN
*-- EOP: Dialog
ENDTEXT
?
RETURN
*-- EOP: GenDialS
PROCEDURE GenInitO
*----------------------------------------------------------------------------
* NAME
* GenInitO -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
TEXT
PROCEDURE InitObjs
*----------------------------------------------------------------------------
* NAME
* InitObjs - Scan the design DBF file and initialize the object variables
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
PRIVATE cField, cClass, cDefault, Value, lInitDef
*--------------------------------------------------
*-- Determine if an initialization array is present
*--------------------------------------------------
ENDTEXT
? ' lInitDef = TYPE( "' + pcDbfDial +'[1]" ) <> "U"'
n = 1 && Pointer to init array
cN = LTRIM( STR( n, 2 ) )
SET ORDER TO ObjOrder
SCAN FOR currentid <> 0
cField = TRIM( fieldname )
cClass = LEFT( cField, 3 )
IF cClass $ "CK_,RB_,LB_,UD_,CS_,CL_,CD_" .AND. RIGHT( cField, 2 ) = "_1"
cVar = "n" + LEFT( cField, RAT( "_", cField ) - 1 )
ENDIF
IF cClass = "BT_"
cDefault = def_val
cDefault = UPPER( TRIM( cDefault ) )
IF cDefault = '"DEFAULT"'
TEXT
*-------------------------------
*-- Set the default button value
*-------------------------------
ENDTEXT
? " nDlgDef = ", TSTR( RECNO() )
nDlgDef = RECNO()
ENDIF
ENDIF
n = n + 1
cN = LTRIM( STR( n, 2 ) )
ENDSCAN
TEXT
*-----------------------------------------------------------------
*-- If the Initialize array is present, then set the object values
*-- based on the array.
*-----------------------------------------------------------------
ENDTEXT
? " IF lInitDef"
GO TOP
n = 1 && Pointer to init array
cN = LTRIM( STR( n, 2 ) )
SCAN FOR currentid <> 0
cField = TRIM( fieldname )
cClass = LEFT( cField, 3 )
IF cClass $ "CK_,RB_,LB_,UD_,CS_,CL_,CD_" .AND. RIGHT( cField, 2 ) = "_1"
cVar = "n" + LEFT( cField, RAT( "_", cField ) - 1 )
ENDIF
IF cClass = "RB_" && For a radio button group
? " IF", pcDbfDial + "[ " + TSTR( n ) +" ]", ;
" " AT 38, "&"+"& If this button is active"
? " ", cVar, "=", TSTR( RECNO() ), ;
" " AT 38, "&"+"& Set the tab into value to this button"
? " ENDIF"
ENDIF
? " ", cField, "=", pcDbfDial + "[ " + TSTR( n ) + " ]"
IF cClass = "LB_"
? " ", cVar, "=", cField
ENDIF
n = n + 1
cN = LTRIM( STR( n, 2 ) )
ENDSCAN
? " ELSE"
TEXT
*--------------------------------------------------------
*-- Otherwise, use the values stored in the resource file
*--------------------------------------------------------
ENDTEXT
GO TOP
n = 1 && Pointer to init array
cN = LTRIM( STR( n, 2 ) )
SCAN FOR currentid <> 0
cField = TRIM( fieldname )
cClass = LEFT( cField, 3 )
IF cClass $ "CK_,RB_,LB_,UD_,CS_,CL_,CD_" .AND. RIGHT( cField, 2 ) = "_1"
cVar = "n" + LEFT( cField, RAT( "_", cField ) - 1 )
ENDIF
*---------------------------------------------------------------
*-- Since there is no array, need to go to the file for defaults
*---------------------------------------------------------------
cDefault = def_val
cDefault = UPPER( TRIM( cDefault ) )
lBlankDef = ISBLANK( cDefault )
IF .NOT. lBlankDef
*-------------------------------------------------------------
*-- Need to pad any pre-defined char field to match either the
*-- scroll or template width of the field
*-------------------------------------------------------------
Value = &cDefault
DO CASE
CASE value_type = "C"
nValue = LEN( Value )
IF pic_scroll > 0
nPadding = pic_scroll - nValue
ELSE
cTemplate = TRIM( template )
nLenTemp = LEN( cTemplate )
nPadding = nLenTemp - nValue
ENDIF
IF nPadding > 0
Value = '"' + Value + SPACE( nPadding ) + '"'
ENDIF
CASE value_type $ "NFD"
Value = cDefault
OTHERWISE
Value = cDefault
ENDCASE
ELSE
*---------------------------------------------------------
*-- There is a blank default, but we have to check now for
*-- multiple choice values to get the default value based
*-- on the first item in the list.
*---------------------------------------------------------
DO CASE
CASE value_type = "C"
IF .NOT. ISBLANK( pic_choice )
cPopChoice = pic_choice
cPopChoice = TRIM( cPopChoice )
cPopType = LEFT( UPPER( cPopChoice ), 4 )
IF cPopType = "FILE" .OR. cPopType = "FIEL" .OR. ;
cPopType = "STRU" .OR. LEFT(cPopType,3) = "DO "
*------------------------------------------------------------
*-- If this is a popup definition, then we only determine the
*-- size of the file.
*------------------------------------------------------------
Value = IIF( pic_scroll > 0, SPACE( pic_scroll ), SPACE( LEN( TRIM( template ) ) ) )
ELSE
*--------------------------------------------------------
*-- For any other value, pick off the first choice in the
*-- list and pad the rest of the string
*--------------------------------------------------------
nComma = AT( ",", cPopChoice )
IF nComma > 0
Value = LEFT( cPopChoice, nComma - 1 )
ELSE
Value = cPopChoice
ENDIF
nValue = LEN( Value )
IF pic_scroll > 0
nPadding = pic_scroll - nValue
ELSE
cTemplate = TRIM( template )
nLenTemp = LEN( cTemplate )
nPadding = nLenTemp - nValue
ENDIF
IF nPadding > 0
Value = Value + SPACE( nPadding )
ENDIF
ENDIF
ELSE
Value = IIF( pic_scroll > 0, SPACE( pic_scroll ), SPACE( LEN( TRIM( template ) ) ) )
ENDIF
Value = Delimit( Value )
*---------------------------------------------------------
*-- There is no multiple choice option for the rest of the
*-- variable types, so set the values to blank.
*---------------------------------------------------------
CASE value_type = "N"
Value = 0
CASE value_type = "D"
Value = "{ / / }"
CASE value_type = "L"
Value = .F.
OTHERWISE
Value = .F.
ENDCASE
ENDIF
*-----------------------------------------------------------
*-- Finally set the object variable to the established value
*-----------------------------------------------------------
DO CASE
CASE cClass = "CS_"
? " ", cField, "=", Value
CASE cClass = "CL_"
? " ", cField, "=", Value
CASE cClass = "CD_"
? " ", cField, "=", Value
CASE cClass = "EF_"
? " ", cField, "=", Value
CASE cClass = "LB_"
? " ", cField, "= 0",
CASE cClass = "UD_"
? " ", cField, "= 0",
CASE cClass = "CK_"
IF lBlankDef
? " ", cField, "= .F."
ELSE
? " ", cField, "=", cDefault
IF cDefault = ".T."
? " ", cVar, "=", TSTR( RECNO() ), ;
" " AT 38, "&"+"& Store the group default value"
ENDIF
ENDIF
CASE cClass = "RB_"
IF lBlankDef
? " ", cField, "= .F."
ELSE
? " ", cField, "=", cDefault
IF cDefault = ".T."
? " ", cVar, "=", TSTR( RECNO() ), ;
" " AT 38, "&"+"& Store the group default value"
ENDIF
ENDIF
CASE cClass = "BT_"
? " ", cField, "=", IIF( "DEFAULT" $ cDefault, ".T.", ".F." )
ENDCASE
n = n + 1
cN = LTRIM( STR( n, 2 ) )
ENDSCAN
? " ENDIF"
SET FILTER TO currentid > 0
GO TOP
l1stTime = .T.
n1stGroup = groupid
n1stObject = RECNO()
c1stClass = LEFT( fieldname, 3 )
cVar = "n" + LEFT( fieldname, RAT( "_", fieldname ) - 1 )
IF c1stClass = "RB_"
? " nCurrent =", cVar
?? "&"+"& Current dialog object id" AT 41
ELSE
nCurrent = RECNO()
? " nCurrent =", TSTR( RECNO() ), ;
" " AT 38, "&"+"& Current dialog object id"
ENDIF
nCurrGrp = groupid
n1stGrp = groupid
? " nCurrGrp =", TSTR( groupid ), ;
" " AT 38, "&"+"& Current group id for object id"
? " n1stGrp =", TSTR( groupid )
* cField = TRIM( fieldname )
* DO GenLabel WITH cField, nCurrent, BN_HILITE, 2
SET FILTER TO
TEXT
RETURN
*-- EOP: InitObjs
ENDTEXT
RETURN
*-- EOP: GenInitO
PROCEDURE GenDraw
*----------------------------------------------------------------------------
* NAME
* GenDraw - Generate calls to the draw routines
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
TEXT
PROCEDURE DrawDial
*----------------------------------------------------------------------------
* NAME
* DrawDial -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
PRIVATE lInitDef
ENDTEXT
? ' lInitDef = TYPE( "' + pcDbfDial +'[1]" ) <> "U"'
? ' IF FILE( "' + pcDbfDial + ".WIN" + '" ) .AND. ( .NOT. lInitDef .OR. ;'
? ' ( TYPE( "FXL_NoChng" ) = "L" .AND. FXL_NoChng ) )'
? ' *--------------------'
? ' *-- Dialog box shadow'
? ' *--------------------'
? ' SAVE SCREEN TO', pcDbfDial
? ' ACTIVATE SCREEN'
GO TOP
sr = row + 1
sc = col + 1
br = row + decimals
bc = col + length
? ' @', TSTR( sr ) + ', ' + TSTR( sc ), 'FILL TO '
?? TSTR( br ) + ', ' + TSTR( bc )
?
? ' RESTORE WINDOW ' + pcDbfDial + " FROM " + pcDbfDial
? ' ACTIVATE WINDOW ' + pcDbfDial
SCAN FOR ( LEFT( fieldname, 3 ) $ "CS_,CL_,CD_,LB_,UD_" .AND. currentid <> 0 ) ;
.OR. fieldname = "TI_TEXT"
cClass = LEFT( fieldname, 3 )
DO CASE
CASE cClass = "CS_"
? ' DO TCombo WITH WM_PAINT, CB_SHOWDRO,', TSTR( RECNO() )
CASE cClass = "CD_"
? ' DO TCombo WITH WM_PAINT, CB_HIDELST,', TSTR( RECNO() )
CASE cClass = "CL_"
? ' DO TCombo WITH WM_PAINT, CB_HIDELST,', TSTR( RECNO() )
CASE cClass = "LB_"
? ' DO TList WITH WM_PAINT, WM_DRAWITEM,', TSTR( RECNO() )
CASE cClass = "UD_"
? ' DO TUser WITH WM_PAINT, WM_DRAWITEM,', TSTR( RECNO() )
CASE cClass = "TI_"
cMemvar = pic_choice
cMemcar = TRIM( cMemvar )
IF LEFT( cMemvar, 1 ) = "{"
cMemvar = SUBSTR( cMemvar, 2, LEN( cMemvar ) - 2 )
? ' IF TYPE( "' + cMemvar + '" ) = "C"'
? " @", TSTR( sys_flen ) + ", " + TSTR( length ), ;
"SAY HelpCTit(",cMemvar+",",TSTR(LEN(TRIM(template)))+", .T. )", ;
"COLOR", cClrTit
? ' ELSE'
? " @", TSTR( sys_flen ) + ", " + TSTR( length ), ;
'SAY REPL( "*",', TSTR( LEN( TRIM( template ) ) ),;
') COLOR', cClrTit
? ' ENDIF'
ENDIF
ENDCASE
ENDSCAN
TEXT
ELSE
*-------------------------
*-- Draw the dialog window
*-------------------------
ENDTEXT
GO TOP
cFrom = expression
cFrom = TRIM( cFrom )
? ' *--------------------'
? ' *-- Dialog box shadow'
? ' *--------------------'
? ' SAVE SCREEN TO', pcDbfDial
? ' ACTIVATE SCREEN'
sr = row + 1
sc = col + 1
br = row + decimals
bc = col + length
? ' @', TSTR( sr ) + ', ' + TSTR( sc ), 'FILL TO '
?? TSTR( br ) + ', ' + TSTR( bc )
?
? ' DEFINE WINDOW', pcDbfDial, cFrom, 'NONE COLOR', cClrDlg
? ' ACTIVATE WINDOW', pcDbfDial
? ' @ 0, 0 TO', TSTR(decimals-1), ',', TSTR(length-1), 'DOUBLE COLOR', cClrTit
TEXT
*------------------------
*-- Close Icon for window
*------------------------
ENDTEXT
? ' @ 0, 2 SAY "[ ]" COLOR', cClrTit
? ' @ 0, 3 SAY CHR( 254 ) COLOR', cClrWBt
TEXT
*---------------------------------
*-- Draw the other control objects
*---------------------------------
ENDTEXT
SCAN
cClass = LEFT( fieldname, 3 )
DO CASE
CASE RECNO() = 1
LOOP
CASE value_type = "B" .AND. RIGHT( TRIM( fieldname ), 2 ) = "_1"
LOOP
CASE value_type = "B" .AND. ISBLANK( fieldname )
nTopRow = sr - 1
nTopCol = sc - 1
? ' @', TSTR( row - nTopRow ) + ',' + TSTR( col - nTopCol ), 'TO', ;
TSTR( row - nTopRow + decimals - 1 ) + ',' + TSTR( col - nTopCol + length )
DO CASE
CASE mem_typ = 0
cBorder = ""
CASE mem_typ = 1
?? ' DOUBLE'
CASE mem_typ = 2
?? ' ' + TRIM( filename )
ENDCASE
cSayColor = GetColor( display )
IF .NOT. ISBLANK( cSayColor )
?? ' COLOR', cSayColor
ENDIF
CASE value_type = "T" && Text element
IF sys_flen = 0
? ' @',TSTR(sys_flen)+','+TSTR(length)+' SAY ' +;
Delimit( TRIM( template ) ) + ' COLOR',cClrTit
ELSE
IF .NOT. ISBLANK( picfun )
cSayColor = TRIM( picfun )
? ' @',TSTR(sys_flen)+','+TSTR(length)+' SAY '+ ;
Delimit( TRIM( template ) ) + ' COLOR',cSayCOlor
ELSE
? ' @',TSTR(sys_flen)+','+TSTR(length)+' SAY ' +;
Delimit( TRIM( template ) )
ENDIF
ENDIF
CASE TRIM( fieldname ) = "TI_TEXT"
cMemvar = pic_choice
cMemcar = TRIM( cMemvar )
IF LEFT( cMemvar, 1 ) = "{"
cMemvar = SUBSTR( cMemvar, 2, LEN( cMemvar ) - 2 )
? ' IF TYPE( "' + cMemvar + '" ) = "C"'
? " @", TSTR( sys_flen ) + ", " + TSTR( length ), ;
"SAY HelpCTit(",cMemvar+",",TSTR(LEN(TRIM(template)))+", .T. )", ;
"COLOR", cClrTit
? ' ELSE'
? " @", TSTR( sys_flen ) + ", " + TSTR( length ), ;
'SAY REPL( "*",', TSTR( LEN( TRIM( template ) ) ),;
') COLOR', cClrTit
? ' ENDIF'
ENDIF
CASE RIGHT( TRIM( fieldname ), 2 ) = "_0"
? ' DO TStatic WITH WM_PAINT, BN_PAINT,', TSTR( RECNO() )
CASE cClass = "BT_" && Button
? ' DO TButton WITH WM_PAINT, BN_PAINT,', TSTR( RECNO() )
IF carry
? ' DO TButton WITH WM_PAINT, SE_SHADOW,', TSTR( RECNO() )
ENDIF
CASE cClass = "EF_" && Edit field
? ' DO TEdit WITH WM_PAINT, EN_KILLFOC,', TSTR( RECNO() )
CASE cClass = "CD_" && Combo box drop down
? ' DO TCombo WITH WM_PAINT, CB_HIDELST,', TSTR( RECNO() )
CASE cClass = "CS_" && Combo box simple
? ' DO TEdit WITH WM_PAINT, EN_KILLFOC,', TSTR( RECNO() )
? ' DO TCombo WITH WM_PAINT, CB_SHOWDRO,', TSTR( RECNO() )
CASE cClass = "CL_" && Combo box drop down list
? ' DO TCombo WITH WM_PAINT, CB_HIDELST,', TSTR( RECNO() )
CASE cClass = "LB_" && List box
? ' DO TList WITH WM_PAINT, WM_DRAWITEM,', TSTR( RECNO() )
CASE cClass = "UD_" && User defined
? ' DO TUser WITH WM_PAINT, WM_DRAWITEM,', TSTR( RECNO() )
CASE cClass = "CK_" && Check box
? ' DO TButton WITH WM_PAINT, BN_PAINT,', TSTR( RECNO() )
CASE cClass = "RB_" && Radio button
? ' DO TButton WITH WM_PAINT, BN_PAINT,', TSTR( RECNO() )
ENDCASE
ENDSCAN
IF TYPE( "nCurrent" ) = "N" .AND. nCurrent > 0
GOTO nCurrent
ENDIF
TEXT
IF .NOT. lInitDef
ENDTEXT
? ' SAVE WINDOW', pcDbfDial, 'TO', pcDbfDial
TEXT
ENDIF
ENDIF
RETURN
*-- EOP: DrawDial
ENDTEXT
RETURN
*-- EOP: GenDraw
PROCEDURE GenLabel
PARAMETERS pc_Field, pn_Current, pn_Way, pn_Indent
*----------------------------------------------------------------------------
* NAME
* GenLabel - Output the command to print the group label
*
* DESCRIPTION
*
* PARAMETERS
* pc_Field =
* pn_Current =
* pn_Way = BN_HILITE or BN_UNHILITE
* pn_Indent = Spaces to indent
*
*----------------------------------------------------------------------------
*-------------------------------------------------
*-- Look to see if the object in focus has a title
*-------------------------------------------------
IF RIGHT( TRIM( pc_Field ), 1 ) $ "123456789"
IF groupid > 0
GOTO groupid
IF RIGHT( TRIM( fieldname ), 1 ) = "0"
IF .NOT. ISBLANK( template )
IF pn_WAY = BN_HILITE
IF ISBLANK( pickkey )
? SPACE( pn_Indent )
?? "@", TSTR( sys_flen ) + ", " + TSTR( length ), ;
"SAY", '"' + TRIM( template ) + '"', "COLOR", cClrStA
ELSE
nLocPick = AT( "~"+pickkey, template )
ctext = descript
? SPACE( pn_Indent )
?? "@", TSTR( sys_flen ) + ", " + TSTR( length ), ;
"SAY", TRIM( ctext ) , "COLOR", cClrStA
ENDIF
ELSE
IF ISBLANK( pickkey )
? SPACE( pn_Indent )
?? "@", TSTR( sys_flen ) + ", " + TSTR( length ), ;
"SAY", '"' + TRIM( template ) + '"', "COLOR", cClrStI
ELSE
nLocPick = AT( "~"+pickkey, template )
ctext = descript
? SPACE( pn_Indent )
?? "@", TSTR( sys_flen ) + ", " + TSTR( length ), ;
"SAY", TRIM( ctext ) , "COLOR", cClrStI
ENDIF
ENDIF
IF .NOT. ISBLANK( pickkey )
? " @", TSTR( sys_flen ) + ", " + TSTR( length + nLocPick - 1 ), ;
'SAY "' + pickkey + '" COLOR', cClrStP
ENDIF
ENDIF
ENDIF
GOTO pn_Current
ENDIF
ENDIF
RETURN
*-- EOP: GenLabel WITH pc_Field, pn_Current, pn_Way, pn_Indent
PROCEDURE GTStatic
PARAMETERS pn_msg, pc_data, pnObject
*----------------------------------------------------------------------------
* NAME
* GTStatic -
*
* DESCRIPTION
*
* PARAMETERS
* pn_msg =
* pc_data =
* pnObject =
*
*----------------------------------------------------------------------------
SET FILTER TO RIGHT( TRIM( fieldname ), 2 ) = "_0" .OR. fieldname = "TI_TEXT"
GO TOP
IF .NOT. EOF()
TEXT
PROCEDURE TStatic
PARAMETERS pn_msg, pc_data, pnObject
*----------------------------------------------------------------------------
* NAME
* TStatic -
*
* DESCRIPTION
*
* PARAMETERS
* pn_msg =
* pc_data =
* pnObject =
*
*----------------------------------------------------------------------------
DO CASE
ENDTEXT
SCAN
cMemvar = pic_choice
cMemcar = TRIM( cMemvar )
IF LEFT( cMemvar, 1 ) = "{"
lMemvar = .T.
cMemvar = SUBSTR( cMemvar, 2, LEN( cMemvar ) - 2 )
ELSE
lMemvar = .F.
ENDIF
cSayColor = GetColor( display )
? " CASE pnObject =", TSTR( RECNO() )
? ' DO CASE'
? ' CASE pc_data = BN_PAINT .OR. pc_data = BN_UNHILITE'
IF ISBLANK( pickkey )
IF .NOT. lMemvar
? " @", TSTR( sys_flen ) + ", " + TSTR( length ), ;
"SAY", Delimit( TRIM( template ) ), "COLOR", cClrStI
ELSE
? ' IF TYPE( "' + cMemvar + '" ) = "C"'
? " @", TSTR( sys_flen ) + ", " + TSTR( length ), ;
"SAY", cMemvar, "COLOR", cClrStI
? ' ELSE'
? " @", TSTR( sys_flen ) + ", " + TSTR( length ), ;
'SAY REPL( "*",', TSTR( LEN( TRIM( template ) ) ),;
') COLOR', cClrStI
? ' ENDIF'
ENDIF
ELSE
nLocPick = AT( "~"+pickkey, template )
ctext = descript
? " @", TSTR( sys_flen ) + ", " + TSTR( length ), ;
"SAY", TRIM( ctext ) , "COLOR", cClrStI
ENDIF
? ' CASE pc_data = BN_HILITE'
IF ISBLANK( pickkey )
IF .NOT. lMemvar
? " @", TSTR( sys_flen ) + ", " + TSTR( length ), ;
"SAY", Delimit( TRIM( template ) ), "COLOR", cClrStA
ELSE
? ' IF TYPE( "' + cMemvar + '" ) = "C"'
? " @", TSTR( sys_flen ) + ", " + TSTR( length ), ;
"SAY", cMemvar, "COLOR", cClrStA
? ' ELSE'
? " @", TSTR( sys_flen ) + ", " + TSTR( length ), ;
'SAY REPL( "*",', TSTR( LEN( TRIM( template ) ) ),;
') COLOR', cClrStA
? ' ENDIF'
ENDIF
ELSE
nLocPick = AT( "~"+pickkey, template )
ctext = descript
? " @", TSTR( sys_flen ) + ", " + TSTR( length ), ;
"SAY", TRIM( ctext ) , "COLOR", cClrStA
ENDIF
? ' CASE pc_data = BN_DISABLE'
IF ISBLANK( pickkey )
IF .NOT. lMemvar
? " @", TSTR( sys_flen ) + ", " + TSTR( length ), ;
"SAY", Delimit( TRIM( template ) ), "COLOR", cClrStN
ELSE
? ' IF TYPE( "' + cMemvar + '" ) = "C"'
? " @", TSTR( sys_flen ) + ", " + TSTR( length ), ;
"SAY", cMemvar, "COLOR", cClrStN
? ' ELSE'
? " @", TSTR( sys_flen ) + ", " + TSTR( length ), ;
'SAY REPL( "*",', TSTR( LEN( TRIM( template ) ) ),;
') COLOR', cClrStN
? ' ENDIF'
ENDIF
ELSE
nLocPick = AT( "~"+pickkey, template )
ctext = descript
? " @", TSTR( sys_flen ) + ", " + TSTR( length ), ;
"SAY", TRIM( ctext ) , "COLOR", cClrStN
ENDIF
? ' CASE pc_data = BN_COLOR'
IF ISBLANK( cSayColor )
cSayColor = cClrStI
ENDIF
IF ISBLANK( pickkey )
IF .NOT. lMemvar
? " @", TSTR( sys_flen ) + ", " + TSTR( length ), ;
"SAY", Delimit( TRIM( template ) ), "COLOR", cSayColor
ELSE
? ' IF TYPE( "' + cMemvar + '" ) = "C"'
? " @", TSTR( sys_flen ) + ", " + TSTR( length ), ;
"SAY", cMemvar, "COLOR", cSayColor
? ' ELSE'
? " @", TSTR( sys_flen ) + ", " + TSTR( length ), ;
'SAY REPL( "*",', TSTR( LEN( TRIM( template ) ) ),;
') COLOR', cSayColor
? ' ENDIF'
ENDIF
ELSE
nLocPick = AT( "~"+pickkey, template )
ctext = descript
? " @", TSTR( sys_flen ) + ", " + TSTR( length ), ;
"SAY", TRIM( ctext ) , "COLOR", cSayColor
ENDIF
? " ENDCASE"
IF .NOT. ISBLANK( pickkey )
? ' IF pc_data <> BN_DISABLE'
? " @", TSTR( sys_flen ) + ", " + TSTR( length + nLocPick - 1 ), ;
'SAY "' + pickkey + '" COLOR', cClrStP
? ' ENDIF'
ENDIF
ENDSCAN
SET FILTER TO
? " ENDCASE"
TEXT
RETURN
*-- EOP: TStatic WITH pn_msg, pc_data, pnObject
ENDTEXT
ENDIF
RETURN
*-- EOP: GTStatic WITH pn_msg, pc_data, pnObject
PROCEDURE GHasTitle
*----------------------------------------------------------------------------
* NAME
* GHasTitle -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
SET FILTER TO RIGHT( TRIM( fieldname ), 1 ) $ "123456789" .AND. ;
groupid > 0
GO TOP
IF .NOT. EOF()
TEXT
PROCEDURE HasTitle
PARAMETERS pnObject, pnWay
*----------------------------------------------------------------------------
* NAME
* HasTitle - Display the label for the group of objects
*
* DESCRIPTION
*
* PARAMETERS
* pnObject = nCurrent value for group item
* pnWay = BN_HILITE, BN_UNHILITE, or BN_DISABLE
*
*----------------------------------------------------------------------------
DO CASE
ENDTEXT
SCAN
? " CASE pnObject =", TSTR( RECNO() )
nObj = RECNO()
GOTO groupid
IF RIGHT( TRIM( fieldname ), 1 ) = "0"
IF .NOT. ISBLANK( template )
? " DO TStatic WITH WM_PAINT, pnWay,", TSTR( RECNO() )
ENDIF
ENDIF
GOTO nObj
ENDSCAN
TEXT
ENDCASE
*-- EOP: HasTitle WITH pnObject, pnWay
ENDTEXT
ELSE
TEXT
PROCEDURE HasTitle
PARAMETERS pnObject, pnWay
*----------------------------------------------------------------------------
* NAME
* HasTitle - Stub
*
*----------------------------------------------------------------------------
RETURN
*-- EOP: HasTitle WITH pnObject, pnWay
ENDTEXT
ENDIF
SET FILTER TO
RETURN
*-- EOP: GHasTitle
PROCEDURE GGetMess
*----------------------------------------------------------------------------
* NAME
* GGetMess -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
TEXT
FUNCTION GetMess
*----------------------------------------------------------------------------
* NAME
* GetMess() -
* DEPENDENCIES
* Uses nCurrent to determine the wait state for the given object.
*----------------------------------------------------------------------------
PRIVATE lRtn
DO CASE
ENDTEXT
SET ORDER TO ObjOrder
SCAN FOR currentid <> 0
cField = TRIM( fieldname )
cClass = LEFT( cField, 3 )
? ' CASE nCurrent =', TSTR( RECNO() ), ;
" " AT 38, "&"+"&", cField
DO CASE
CASE cClass = "BT_" && Button
IF nDlgDef > 0 .AND. nDlgDef <> RECNO()
? ' DO TButton WITH WM_PAINT, BN_UNHILITE,', TSTR( nDlgDef )
? ' ', cField, '= .F.'
ENDIF
? ' DO GetWait'
bt = .t.
CASE cClass = "EF_" && Edit field
? ' ON KEY LABEL F1 DO DlgHlpHd'
? ' DO GetEdit'
? ' ON KEY LABEL F1'
ef = .t.
CASE cClass = "CD_" && Combo box drop down
? ' ON KEY LABEL F1 DO DlgHlpHd'
? ' DO GetDD'
? ' ON KEY LABEL F1'
cd = .t.
CASE cClass = "CS_" && Combo box simple
? ' ON KEY LABEL F1 DO DlgHlpHd'
? ' DO GetEdit'
? ' ON KEY LABEL F1'
cs = .t.
CASE cClass = "CL_" && Combo box drop down list
? ' DO GetDDL'
cl = .t.
CASE cClass = "LB_" && List box
? ' ON KEY LABEL F1 DO DlgHlpHd'
? ' DO TList WITH LBN_SETFOC, .F.,', TSTR( RECNO() )
? ' ON KEY LABEL F1'
lb = .t.
CASE cClass = "UD_" && User defined
? ' DO TUser WITH LBN_SETFOC, .F.,', TSTR( RECNO() )
ud = .t.
CASE cClass = "CK_" && Check box
? ' DO GetWait'
ck = .t.
CASE cClass = "RB_" && Radio button
? ' DO GetWait'
rb = .t.
ENDCASE
ENDSCAN
TEXT
ENDCASE
IF nMess = KB_F1
DO _HelpSys WITH cDialog, ;
LEFT( TRANSFORM( aObjPoint[ nCurrent ], "@L 99" ) + ;
aClkObj[ aObjPoint[ nCurrent ], 11 ], 10 ), ;
cHelpFile
ENDIF
IF nMess = KB_ESC
lRtn = .T.
ELSE
lRtn = .F.
ENDIF
RETURN lRtn
*-- EOF: GetMess( )
PROCEDURE DlgHlpHd
*----------------------------------------------------------------------------
* NAME
* DlgHlpHd -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
DO _HelpSys WITH cDialog, ;
LEFT( TRANSFORM( aObjPoint[ nCurrent ], "@L 99" ) + ;
aClkObj[ aObjPoint[ nCurrent ], 11 ], 10 ), ;
cHelpFile
nMess = 0
RETURN
*-- EOP: DlgHlpHd
ENDTEXT
RETURN
*-- EOP: GGetMess
PROCEDURE GGetWait
*----------------------------------------------------------------------------
* NAME
* GGetWait -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
TEXT
PROCEDURE GetWait
*----------------------------------------------------------------------------
* NAME
* GetWait -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
nMess = 0
nAccel = 0
lButtAct = .T.
DO TButton WITH WM_PAINT, BN_HILITE, nCurrent
SET CONSOLE OFF
SET CURSOR OFF
WAIT
SET CONSOLE ON
nMess = LASTKEY()
nMRow = MROW()
nMCol = MCOL()
RETURN
*-- EOP: GetWait
ENDTEXT
RETURN
*-- EOP: GGetWait
PROCEDURE GTButton
*----------------------------------------------------------------------------
* NAME
* GTButton -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
TEXT
PROCEDURE TButton
PARAMETERS pn_msg, pc_data, pnObject
*----------------------------------------------------------------------------
* NAME
* TButton -
*
* DESCRIPTION
*
* PARAMETERS
* pn_msg =
* pc_data =
* pnObject =
*
*----------------------------------------------------------------------------
DO CASE
ENDTEXT
SET ORDER TO ObjOrder
SCAN FOR currentid > 0 .AND. LEFT( fieldname, 3 ) $ "RB_,CK_,BT_"
cClass = LEFT( fieldname, 3 )
cField = TRIM( fieldname )
? ' CASE pnObject =', TSTR( RECNO() ), ;
" " AT 38, "&"+"&", cField
? ' DO CASE'
? ' CASE pn_msg = WM_PAINT'
DO CASE
CASE cClass = "BT_"
IF ISBLANK( descript )
cPrompt = Delimit( TRIM( template ) )
ELSE
cPrompt = descript
IF cPrompt = '"^"'
cPrompt = "'" + CHR(30) + "'"
ELSE
IF cPrompt = '"v"'
cPrompt = "'" + CHR(31) + "'"
ENDIF
ENDIF
ENDIF
? ' DO CASE'
? ' CASE pc_data = BN_PAINT'
IF nDlgDef = RECNO()
? ' @',TSTR(sys_flen)+', '+TSTR(length), ;
'SAY', cPrompt, 'COLOR', cClrBtD
ELSE
? ' @',TSTR(sys_flen)+', '+TSTR(length), ;
'SAY', cPrompt, 'COLOR', cClrBtI
ENDIF
? ' CASE pc_data = BN_HILITE'
? ' @',TSTR(sys_flen)+', '+TSTR(length), ;
'SAY', cPrompt, 'COLOR', cClrBtA
? ' CASE pc_data = BN_UNHILITE'
? ' @',TSTR(sys_flen)+', '+TSTR(length), ;
'SAY', cPrompt, 'COLOR', cClrBtI
? ' CASE pc_data = BN_DEFAULT'
? ' @',TSTR(sys_flen)+', '+TSTR(length), ;
'SAY', cPrompt, 'COLOR', cClrBtD
? ' CASE pc_data = BN_DISABLE'
? ' @',TSTR(sys_flen)+', '+TSTR(length), ;
'SAY', cPrompt, 'COLOR', cClrBtN
IF carry
? ' CASE pc_data = SE_SHADOW'
? ' @',TSTR(sys_flen+1)+', '+TSTR(length+1), ;
'SAY "' + REPLICATE( CHR( 223 ), LEN( &cPrompt ) ) + ;
'"' + ' COLOR ' + cClrDlg
? ' @',TSTR(sys_flen)+', '+TSTR(length+LEN(&cPrompt)), ;
'SAY "' + CHR(220) + '"' + ' COLOR ' + cClrDlg
? ' CASE pc_data = BN_PRESSED'
? ' @',TSTR(sys_flen+1)+', '+TSTR(length+1)
?? ' SAY SPACE(', TSTR( LEN( &cPrompt ) ), ')' + ;
' COLOR ' + cClrDlg
? ' @',TSTR(sys_flen)+', '+TSTR(length)
?? ' SAY " "' + ' COLOR ' + cClrDlg
? ' @',TSTR(sys_flen)+', ' + TSTR(length + LEN( &cPrompt ) )
?? ' SAY " "' + ' COLOR ' + cClrDlg
? ' @',TSTR(sys_flen)+', '+TSTR(length+1)
?? ' SAY', cPrompt, 'COLOR', cClrBtA
ENDIF
? ' ENDCASE'
IF .NOT. ISBLANK( pickkey )
nKeyPos = AT( "~", template )
? ' IF pc_data <> BN_PRESSED .AND. pc_data <> BN_DISABLE'
? ' @',TSTR(sys_flen)+', '+TSTR(length+nKeyPos-1), ;
'SAY "' + pickkey + '"', 'COLOR', cClrBtP
? ' ENDIF'
ENDIF
? ' CASE pn_msg = BN_CLICKED'
IF carry
? ' DO TButton WITH WM_PAINT, BN_PRESSED,', TSTR( RECNO() )
ENDIF
cOkCond = ok_cond
DO CASE
CASE fieldname = "BT_OK"
IF .NOT. ISBLANK( cOkCond )
? ' IF', cOkCond
? ' nMess = DLN_OK'
? ' ENDIF'
? ' x = INKEY( .2 )'
ELSE
? ' x = INKEY( .2 )'
? ' nMess = DLN_OK'
ENDIF
CASE fieldname = "BT_CANCEL"
IF .NOT. ISBLANK( cOkCond )
? ' IF', cOkCond
? ' nMess = DLN_CANCEL'
? ' ENDIF'
? ' x = INKEY( .2 )'
ELSE
? ' x = INKEY( .2 )'
? ' nMess = DLN_CANCEL'
ENDIF
CASE fieldname = "BT_HELP"
TEXT
DO _HelpSys WITH cDialog, ;
LEFT( TRANSFORM( aObjPoint[ nCurrent ], "@L 99" ) + ;
aClkObj[ aObjPoint[ nCurrent ], 11 ], 10 ), ;
cHelpFile
ENDTEXT
OTHERWISE
IF .NOT. ISBLANK( cOkCond )
?
IF UPPER( LEFT( cOkCond, 3 ) ) = "DO("
cDoExpr = SUBSTR( cOkCond, 3 )
? ' *---------------------------------------'
? ' *-- Do the program contained in DO() UDF'
? ' *---------------------------------------'
? ' DO', &cDoExpr
ELSE
? ' IF', ok_cond
? ' ENDIF'
ENDIF
ENDIF
?
ENDCASE
IF carry
? ' DO TButton WITH WM_PAINT, BN_PAINT,', TSTR( RECNO() )
? ' DO TButton WITH WM_PAINT, SE_SHADOW,', TSTR( RECNO() )
ENDIF
? ' ENDCASE'
?
CASE cClass = "RB_"
IF ISBLANK( descript )
nLen = decimals - col + 1
cPrompt = template
cPrompt = Delimit( LEFT( TRIM( cPrompt ) + SPACE( nLen ), nLen ) )
ELSE
nLen = decimals - col + 1
cPrompt = SUBSTR( descript, 2 )
cPrompt = TRIM( cPrompt )
cPrompt = LEFT( cPrompt, LEN( cPrompt ) - 1 )
cPrompt = LEFT( TRIM( cPrompt ) + SPACE( nLen ), nLen + 1 )
cPrompt = Delimit( cPrompt )
ENDIF
? ' DO CASE'
? ' CASE pc_data = BN_PAINT .OR. pc_data = BN_UNHILITE'
? ' @',TSTR(sys_flen)+', '+TSTR(length), ;
'SAY', cPrompt, 'COLOR', cClrCkI
? ' IF', cField
? ' @',TSTR(sys_flen)+', '+TSTR(length+1), ;
'TO', TSTR(sys_flen)+', '+TSTR(length+1)+ ' 7', ;
'COLOR', cClrCkI
? ' ELSE'
? ' @',TSTR(sys_flen)+', '+TSTR(length+1), ;
'SAY " " COLOR', cClrCkI
? ' ENDIF'
? ' CASE pc_data = BN_HILITE'
? ' @',TSTR(sys_flen)+', '+TSTR(length), ;
'SAY', cPrompt, 'COLOR', cClrCkA
? ' IF', cField
? ' @',TSTR(sys_flen)+', '+TSTR(length+1), ;
'TO', TSTR(sys_flen)+', '+TSTR(length+1)+ ' 7', ;
'COLOR', cClrCkA
? ' ELSE'
? ' @',TSTR(sys_flen)+', '+TSTR(length+1), ;
'SAY " " COLOR', cClrCkA
? ' ENDIF'
? ' CASE pc_data = BN_DISABLE'
? ' @',TSTR(sys_flen)+', '+TSTR(length), ;
'SAY', cPrompt, 'COLOR', cClrCkN
? ' IF', cField
? ' @',TSTR(sys_flen)+', '+TSTR(length+1), ;
'TO', TSTR(sys_flen)+', '+TSTR(length+1)+ ' 7', ;
'COLOR', cClrCkN
? ' ELSE'
? ' @',TSTR(sys_flen)+', '+TSTR(length+1), ;
'SAY " " COLOR', cClrCkN
? ' ENDIF'
? ' ENDCASE'
IF .NOT. ISBLANK( pickkey )
nKeyPos = AT( "~", template )
? ' IF pc_data <> BN_DISABLE'
? ' @',TSTR(sys_flen)+', '+TSTR(length+nKeyPos-1), ;
'SAY "' + pickkey + '"', 'COLOR', cClrCkP
? ' ENDIF'
ENDIF
? ' CASE pn_msg = BN_CLICKED'
? ' IF', cField
? ' STORE .F. TO', cField
? ' ELSE'
? ' STORE .T. TO', cField
? ' ENDIF'
cOkCond = ok_cond
IF .NOT. ISBLANK( cOkCond )
?
IF UPPER( LEFT( cOkCond, 3 ) ) = "DO("
cDoExpr = SUBSTR( cOkCond, 3 )
? ' *---------------------------------------'
? ' *-- Do the program contained in DO() UDF'
? ' *---------------------------------------'
? ' DO', &cDoExpr
ELSE
? ' *-------------------------------'
? ' *-- Execute the VALID expression'
? ' *-------------------------------'
? ' IF', ok_cond
? ' ENDIF'
ENDIF
ENDIF
?
? ' ENDCASE'
CASE cClass = "CK_"
IF ISBLANK( descript )
nLen = decimals - col + 1
cPrompt = template
cPrompt = Delimit( LEFT( TRIM( cPrompt ) + SPACE( nLen ), nLen ) )
ELSE
nLen = decimals - col + 1
cPrompt = SUBSTR( descript, 2 )
cPrompt = TRIM( cPrompt )
cPrompt = LEFT( cPrompt, LEN( cPrompt ) - 1 )
cPrompt = LEFT( TRIM( cPrompt ) + SPACE( nLen ), nLen + 1 )
cPrompt = Delimit( cPrompt )
ENDIF
? ' DO CASE'
? ' CASE pc_data = BN_PAINT .OR. pc_data = BN_UNHILITE'
? ' @',TSTR(sys_flen)+', '+TSTR(length), ;
'SAY', cPrompt, 'COLOR', cClrCkI
? ' @',TSTR(sys_flen)+', '+TSTR(length+1), ;
'SAY IIF(', cField, ', "X"," " ) COLOR', cClrCkI
? ' CASE pc_data = BN_HILITE'
? ' @',TSTR(sys_flen)+', '+TSTR(length), ;
'SAY', cPrompt, 'COLOR', cClrCkA
? ' @',TSTR(sys_flen)+', '+TSTR(length+1), ;
'SAY IIF(', cField, ', "X"," " ) COLOR', cClrCkA
? ' CASE pc_data = BN_DISABLE'
? ' @',TSTR(sys_flen)+', '+TSTR(length), ;
'SAY', cPrompt, 'COLOR', cClrCkN
? ' @',TSTR(sys_flen)+', '+TSTR(length+1), ;
'SAY IIF(', cField, ', "X"," " ) COLOR', cClrCkN
? ' ENDCASE'
IF .NOT. ISBLANK( pickkey )
nKeyPos = AT( "~", template )
? ' IF pc_data <> BN_DISABLE'
? ' @',TSTR(sys_flen)+', '+TSTR(length+nKeyPos-1), ;
'SAY "' + pickkey + '"', 'COLOR', cClrCkP
? ' ENDIF'
ENDIF
? ' CASE pn_msg = BN_CLICKED'
? ' IF', cField
? ' STORE .F. TO', cField
? ' ELSE'
? ' STORE .T. TO', cField
? ' ENDIF'
cOkCond = ok_cond
IF .NOT. ISBLANK( cOkCond )
?
IF UPPER( LEFT( cOkCond, 3 ) ) = "DO("
cDoExpr = SUBSTR( cOkCond, 3 )
? ' *---------------------------------------'
? ' *-- Do the program contained in DO() UDF'
? ' *---------------------------------------'
? ' DO', &cDoExpr
ELSE
? ' *-------------------------------'
? ' *-- Execute the VALID expression'
? ' *-------------------------------'
? ' IF', ok_cond
? ' ENDIF'
ENDIF
ENDIF
?
? ' DO TButton WITH WM_PAINT, BN_HILITE,', TSTR( RECNO() )
? ' ENDCASE'
ENDCASE
ENDSCAN
TEXT
ENDCASE
RETURN
*-- EOP: TButton WITH pn_msg, pc_data, pnObject
ENDTEXT
RETURN
*-- EOP: GTButton
PROCEDURE GGetEdit
*----------------------------------------------------------------------------
* NAME
* GGetEdit -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
TEXT
PROCEDURE GetEdit
*----------------------------------------------------------------------------
* NAME
* GetEdit -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
PRIVATE lSkipRead
lSkipRead = .F.
nMess = 0
nAccel = 0
nMsEvent = 0
ON MOUSE DO MsHand WITH MROW(), MCOL()
DO SetOnKey
DO CASE
ENDTEXT
SET ORDER TO ObjOrder
SET FILTER TO
SCAN FOR currentid > 0 .AND. ;
LEFT( fieldname, 3 ) $ "EF_,CS_" .AND. ;
RIGHT( TRIM( fieldname ), 2 ) <> "_0"
? ' CASE nCurrent =', TSTR( RECNO() )
IF pic_scroll > 0
cPict = "'@S" + TSTR( LEN( TRIM( template ) ) ) + "'"
ELSE
cPict = '"' + TRIM( template ) + '"'
ENDIF
? ' @', TSTR( sys_flen ) + ', ' + TSTR( length ) + ' GET '
?? TRIM( fieldname ), 'PICTURE', cPict
IF LEFT( fieldname, 3 ) = "CS_"
nRecNo = RECNO()
cField = fieldname
i = 1
SCAN FOR value_type = "B" .AND. LEFT( fieldname, 3 ) $ "CS_,LB_,UD_"
IF cField = fieldname
? ' IF aClkBox[', TSTR( i ), ',6 ]'
? ' lSkipRead = .T.'
? ' aClkBox[', TSTR( i ), ',6 ] = .F.'
? ' ENDIF'
EXIT
ENDIF
i = i + 1
ENDSCAN
GOTO nRecNo
ENDIF
ENDSCAN
TEXT
ENDCASE
IF .NOT. lSkipRead
SET CURSOR ON
READ
SET CURSOR OFF
ENDIF
DO ClrOnKey
ON MOUSE
IF .NOT. lSkipRead
IF nMsEvent = KB_MOUSE
nMess = KB_MOUSE
ELSE
nMess = LASTKEY()
ENDIF
ELSE
nMess = KB_DOWNARROW
ENDIF
RETURN
*-- EOP: GetEdit
ENDTEXT
RETURN
*-- EOP: GGetEdit
PROCEDURE GTEdit
*----------------------------------------------------------------------------
* NAME
* GTEdit -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
TEXT
PROCEDURE TEdit
PARAMETERS pn_msg, p__data, pnObject
*----------------------------------------------------------------------------
* NAME
* TEdit -
*
* DESCRIPTION
*
* PARAMETERS
* pn_msg =
* p__data =
* pnObject =
*
*----------------------------------------------------------------------------
DO CASE
ENDTEXT
SET ORDER TO ObjOrder
SCAN FOR currentid > 0 .AND. LEFT( fieldname, 3 ) $ "EF_,CS_"
cClass = LEFT( fieldname, 3 )
cField = TRIM( fieldname )
? ' CASE pnObject =', TSTR( RECNO() )
?? "&"+"&" AT 41, cField
? ' DO CASE'
? ' CASE p__data = EN_KILLFOC'
IF pic_scroll > 0
cPict = "'@S"+LTRIM(STR(pic_scroll))+" "+TRIM(template)+ "'"
ELSE
cPict = '"' + TRIM( template ) + '"'
ENDIF
? ' @', TSTR( sys_flen ) + ', ' + TSTR( length ) + ' GET '
?? cField, 'PICTURE', cPict
? ' CLEAR GETS'
? ' ENDCASE'
?
ENDSCAN
TEXT
ENDCASE
RETURN
*-- EOP: TEdit WITH pn_msg, p__data, pnObject
ENDTEXT
RETURN
*-- EOP: GTEdit
PROCEDURE GSetOnKey
*----------------------------------------------------------------------------
* NAME
* GSetOnKey -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
TEXT
PROCEDURE SetOnKey
*----------------------------------------------------------------------------
* NAME
* SetOnKey - For each pick key, set on key label
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
ENDTEXT
SCAN FOR .NOT. ISBLANK( pickkey )
cAltKey = "Alt-" + pickkey
IF RIGHT( TRIM( fieldname ), 2 ) = "_0"
cRec = "'" + LTRIM( STR( previd ) ) + "'"
ELSE
cRec = "'" + LTRIM( STR( currentid ) ) + "'"
ENDIF
? ' ON KEY LABEL', cAltKey, 'DO AKeyHand WITH', cRec
ENDSCAN
TEXT
RETURN
*-- EOP: SetOnKey
ENDTEXT
RETURN
*-- EOP: GSetOnKey
PROCEDURE GClrOnKey
*----------------------------------------------------------------------------
* NAME
* GClrOnKey -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
TEXT
PROCEDURE ClrOnKey
*----------------------------------------------------------------------------
* NAME
* ClrOnKey - For each pick key, clear on label
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
ENDTEXT
SCAN FOR .NOT. ISBLANK( pickkey )
cAltKey = "Alt-" + pickkey
? ' ON KEY LABEL', cAltKey
ENDSCAN
TEXT
RETURN
*-- EOP: ClrOnKey
ENDTEXT
RETURN
*-- EOP: GClrOnKey
PROCEDURE GAKeyHand
*----------------------------------------------------------------------------
* NAME
* GAKeyHand -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
TEXT
PROCEDURE AKeyHand
PARAMETERS cId
*----------------------------------------------------------------------------
* NAME
* AKeyHand - On key handler for Accel key from popup or get
*
* DESCRIPTION
*
* PARAMETERS
* nId =
*
*----------------------------------------------------------------------------
IF nAccel <> nCurrent
nAccel = VAL( cId )
ENDTEXT
IF cd .OR. cs .OR. cl .OR. lb .OR. ud
? ' IF TYPE( "pl_IsPop" ) = "L" .AND. pl_IsPop'
? ' DO CASE'
SCAN FOR currentid > 0 .AND. LEFT( fieldname, 3 ) $ "CD_,CS_,CL_,LB_,UD_"
cField = TRIM( fieldname )
cVar = "n" + LEFT( cField, RAT( "_", cField ) - 1 )
? ' CASE nCurrent =', TSTR( RECNO() )
IF LEFT( fieldname, 3 ) <> "UD_"
? ' STORE BAR() TO', cVar
? ' SAVE SCREEN TO', cField
? ' KEYBOARD "{LeftArrow}"'
? ' nMess = KB_ENTER'
ELSE
cOkCond = ok_cond
cOkCond = TRIM( cOkCond )
IF .NOT. ISBLANK( cOkCond )
? ' IF', cOkCond
? ' ENDIF'
ENDIF
ENDIF
ENDSCAN
? ' OTHERWISE'
? ' KEYBOARD "{Ctrl-W}"'
? ' nMess = KB_CTRLW'
? ' ENDCASE'
? ' ELSE'
? ' KEYBOARD "{Ctrl-W}"'
? ' nMess = KB_CTRLW'
? ' ENDIF'
ELSE
TEXT
KEYBOARD "{Ctrl-W}"
nMess = KB_CTRLW
ENDTEXT
ENDIF
TEXT
ELSE
nAccel = 0
ENDIF
RETURN
*-- EOP: AKeyHand WITH nId
ENDTEXT
RETURN
*-- EOP: GAKeyHand
PROCEDURE GReleObjs
*----------------------------------------------------------------------------
* NAME
* GReleObjs -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
SET ORDER TO ObjOrder
SET FILTER TO currentid > 0 .AND. ;
LEFT( TRIM( fieldname ), 3 ) $ "LB_,UD_,CS_,CL_,CD_" .AND. ;
RIGHT( TRIM( fieldname ), 2 ) = "_1"
GO TOP
TEXT
PROCEDURE ReleObjs
*----------------------------------------------------------------------------
* NAME
* ReleObjs - Scan the design DBF file and release the object variables
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
ENDTEXT
IF .NOT. EOF()
SCAN
cField = TRIM( fieldname )
IF LEFT( fieldname, 3 ) = "UD_"
? ' RELEASE WINDOW', cField
ELSE
? ' RELEASE POPUP', cField
ENDIF
ENDSCAN
ENDIF
TEXT
RETURN
*-- EOP: ReleObjs
ENDTEXT
SET FILTER TO
RETURN
*-- EOP: GReleObjs
PROCEDURE GDispatch
*----------------------------------------------------------------------------
* NAME
* GDispatch -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
TEXT
PROCEDURE Dispatch
*----------------------------------------------------------------------------
* NAME
* Dispatch -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
ENDTEXT
? ' DO CASE'
SET ORDER TO ObjOrder
SCAN FOR currentid > 0
cClass = LEFT( fieldname, 3 )
cField = TRIM( fieldname )
? ' CASE nCurrent =', TSTR( RECNO() )
?? "&"+"&" AT 41, cField
DO CASE
CASE cClass = "BT_"
? ' DO DispBt'
CASE cClass = "EF_"
? ' DO DispEf'
CASE cClass = "CK_"
? ' DO DispCk'
CASE cClass = "RB_"
? ' DO DispRb'
CASE cClass = "LB_"
? ' DO DispLb'
CASE cClass = "UD_"
? ' DO DispUd'
CASE cClass = "CD_"
? ' DO DispCD'
CASE cClass = "CS_"
? ' DO DispCS'
CASE cClass = "CL_"
? ' DO DispCL'
ENDCASE
ENDSCAN
? ' ENDCASE'
TEXT
RETURN
*-- EOP: Dispatch
ENDTEXT
RETURN
*-- EOP: GDispatch
PROCEDURE GDisp
*----------------------------------------------------------------------------
* NAME
* GDisp -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
IF rb
TEXT
PROCEDURE DispRb
*----------------------------------------------------------------------------
* NAME
* DispRb -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
PRIVATE nPossNext
DO CASE
CASE nMess = KB_TAB
DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent
DO GetNext WITH .T.
CASE nMess = KB_SHIFTTAB
DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent
DO GetNext WITH .F.
CASE nMess = KB_UPARROW .OR. nMess = KB_LEFTARROW
DO TButton WITH BN_CLICKED, .F., nCurrent
DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent
DO GetNext WITH .F., .T.
DO TButton WITH BN_CLICKED, .F., nCurrent
CASE nMess = KB_DOWNARROW .OR. nMess = KB_RTARROW
DO TButton WITH BN_CLICKED, .F., nCurrent
DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent
DO GetNext WITH .T., .T.
DO TButton WITH BN_CLICKED, .F., nCurrent
CASE nMess = KB_MOUSE
nPossNext = GetMsTo()
IF nPossNext > 0
IF nPossNext <> nCurrent
DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent
DO GetNext WITH nPossNext, .F.
ENDIF
ENDIF
CASE nMess = KB_ENTER
IF nDlgDef > 0
DO TButton WITH BN_CLICKED, .F., nDlgDef
ENDIF
OTHERWISE
DO CkWaitAc
IF nAccel > 0
IF nAccel <> nCurrent
DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent
DO GetNext WITH nAccel, .F.
ENDIF
ENDIF
ENDCASE
RETURN
*-- EOP: DispRb
ENDTEXT
ENDIF && Rb
IF Ck
TEXT
PROCEDURE DispCk
*----------------------------------------------------------------------------
* NAME
* DispCk -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
PRIVATE nPossNext
DO CASE
CASE nMess = KB_TAB
DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent
DO GetNext WITH .T.
CASE nMess = KB_SHIFTTAB
DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent
DO GetNext WITH .F.
CASE nMess = KB_UPARROW .OR. nMess = KB_LEFTARROW
DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent
DO GetNext WITH .F., .T.
CASE nMess = KB_DOWNARROW .OR. nMess = KB_RTARROW
DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent
DO GetNext WITH .T., .T.
CASE nMess = KB_SPACE
DO TButton WITH BN_CLICKED, .F., nCurrent
CASE nMess = KB_MOUSE
nPossNext = GetMsTo()
IF nPossNext > 0
IF nPossNext = nCurrent
DO TButton WITH BN_CLICKED, .F., nCurrent
ELSE
DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent
DO GetNext WITH nPossNext, .F.
ENDIF
ENDIF
CASE nMess = KB_ENTER
IF nDlgDef > 0
DO TButton WITH BN_CLICKED, .F., nDlgDef
ENDIF
OTHERWISE
DO CkWaitAc
IF nAccel > 0
IF nAccel = nCurrent
DO TButton WITH BN_CLICKED, .F., nCurrent
ELSE
DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent
DO GetNext WITH nAccel, .F.
ENDIF
ENDIF
ENDCASE
RETURN
*-- EOP: DispCk
ENDTEXT
ENDIF && Ck
IF bt
TEXT
PROCEDURE DispBt
*----------------------------------------------------------------------------
* NAME
* DispBt -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
PRIVATE nPossNext
DO CASE
CASE nMess = KB_TAB
DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent
DO GetNext WITH .T.
CASE nMess = KB_SHIFTTAB
DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent
DO GetNext WITH .F.
CASE nMess = KB_ENTER
DO TButton WITH BN_CLICKED, .F., nCurrent
CASE nMess = KB_MOUSE
nPossNext = GetMsTo()
IF nPossNext > 0
IF nPossNext = nCurrent
DO TButton WITH BN_CLICKED, .F., nCurrent
ELSE
DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent
DO GetNext WITH nPossNext, .F.
ENDIF
ENDIF
OTHERWISE
DO CkWaitAc
IF nAccel > 0
IF nAccel = nCurrent
DO TButton WITH BN_CLICKED, .F., nCurrent
ELSE
DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent
DO GetNext WITH nAccel, .F.
ENDIF
ENDIF
ENDCASE
RETURN
*-- EOP: DispBt
ENDTEXT
ENDIF && Bt
IF ef
TEXT
PROCEDURE DispEf
*----------------------------------------------------------------------------
* NAME
* DispEf -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
PRIVATE nPossNext
DO CASE
CASE nMess = KB_TAB
DO GetNext WITH .T.
CASE nMess = KB_SHIFTTAB
DO GetNext WITH .F.
CASE nMess = KB_ENTER
IF nDlgDef > 0
DO GetNext WITH nDlgDef
IF nCurrent = nDlgDef
DO TButton WITH BN_CLICKED, .F., nDlgDef
ENDIF
ENDIF
CASE nMess = KB_UPARROW
DO GetNext WITH .F., .T.
CASE nMess = KB_DOWNARROW
DO GetNext WITH .T., .T.
CASE nMess = KB_MOUSE
nPossNext = GetMsTo()
IF nPossNext > 0
DO GetNext WITH nPossNext, .F.
ENDIF
CASE nMess = KB_CTRLW .AND. nAccel > 0
DO GetNext WITH nAccel, .F.
ENDCASE
RETURN
*-- EOP: DispEf
ENDTEXT
ENDIF
IF lb
TEXT
PROCEDURE DispLb
*----------------------------------------------------------------------------
* NAME
* DispLb -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
PRIVATE nPossNext
DO CASE
CASE nMess = KB_TAB
DO GetNext WITH .T.
CASE nMess = KB_SHIFTTAB
DO GetNext WITH .F.
CASE nMess = KB_MOUSE
nPossNext = GetMsTo()
IF nPossNext > 0
DO GetNext WITH nPossNext, .F.
ENDIF
CASE nAccel > 0 && dBRIEF Tag...
DO GetNext WITH nAccel, .F.
CASE nMess = KB_ENTER
IF nDlgDef > 0
DO GetNext WITH nDlgDef
IF nCurrent = nDlgDef
DO TButton WITH BN_CLICKED, .F., nDlgDef
ENDIF
ENDIF
ENDCASE
RETURN
*-- EOP: DispLb
ENDTEXT
ENDIF && lb
IF ud
TEXT
PROCEDURE DispUd
*----------------------------------------------------------------------------
* NAME
* DispUd -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
PRIVATE nPossNext
DO CASE
CASE nMess = KB_TAB
DO GetNext WITH .T.
CASE nMess = KB_SHIFTTAB
DO GetNext WITH .F.
CASE nMess = KB_MOUSE
nPossNext = GetMsTo()
IF nPossNext > 0
DO GetNext WITH nPossNext, .F.
ENDIF
CASE nMess = KB_CTRLW .AND. nAccel > 0
DO GetNext WITH nAccel, .F.
CASE nMess = KB_ENTER
IF nDlgDef > 0
DO TButton WITH BN_CLICKED, .F., nDlgDef
ENDTEXT
SET FILTER TO currentid > 0 .AND. ;
LEFT( fieldname, 3 ) = "UD_" .AND. ;
.NOT. ISBLANK( ok_cond )
GO TOP
IF .NOT. EOF()
? ' ELSE'
? ' DO CASE'
SCAN
? ' CASE nCurrent =', TSTR( RECNO() )
?? '&'+'& Validation for:', TRIM( fieldname )
cOkCond = ok_cond
IF UPPER( LEFT( cOkCond, 3 ) ) = "DO("
*-- cDoExpr = '("TVDIAL")'
cDoExpr = SUBSTR( cOkCond, 3 )
? ' DO', &cDoExpr
ELSE
? ' IF', ok_cond
? ' ENDIF'
ENDIF
ENDSCAN
? ' ENDCASE'
endif
TEXT
ENDIF
ENDCASE
RETURN
*-- EOP: DispUd
ENDTEXT
ENDIF && Ud
IF cs
TEXT
PROCEDURE DispCS
*----------------------------------------------------------------------------
* NAME
* DispCS -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
DO CASE
CASE nMess = KB_TAB
DO GetNext WITH .T.
CASE nMess = KB_SHIFTTAB
DO GetNext WITH .F.
CASE nMess = KB_ENTER
IF nDlgDef > 0
DO GetNext WITH nDlgDef
IF nCurrent = nDlgDef
DO TButton WITH BN_CLICKED, .F., nDlgDef
ENDIF
ENDIF
CASE nMess = KB_DOWNARROW .OR. ;
nMess = KB_UPARROW
ENDTEXT
SET FILTER TO currentid > 1 .AND. ;
LEFT( fieldname, 3 ) = "CS_" .AND. ;
.NOT. ISBLANK( ok_cond )
GO TOP
IF .NOT. EOF()
TEXT
*-----------------------------------------------
*-- GENCODE - Do VALID code here from Memo field
*-----------------------------------------------
DO CASE
ENDTEXT
SCAN
cClass = LEFT( fieldname, 3 )
cField = TRIM( fieldname )
? ' CASE nCurrent =', TSTR( RECNO() )
?? "&"+"&" AT 41, cField
cOkCond = ok_cond
IF UPPER( LEFT( cOkCond, 3 ) ) = "DO("
*-- cDoExpr = '("TVDIAL")'
cDoExpr = SUBSTR( cOkCond, 3 )
? ' DO', &cDoExpr
ELSE
? ' IF', ok_cond
? ' ENDIF'
ENDIF
ENDSCAN
? ' ENDCASE'
ENDIF
SET FILTER TO
TEXT
DO TCombo WITH CBN_INLIST, .F., nCurrent
IF nMsEvent = KB_MOUSE
nPossNext = GetMsTo()
ELSE
IF nAccel > 0
DO GetNext WITH nAccel
RETURN
ELSE
nPossNext = 0
DO CASE
ENDTEXT
i = 1
SCAN FOR value_type = "B" .AND. LEFT( fieldname, 3 ) $ "CS_,LB_,UD_"
IF LEFT( fieldname, 3 ) = "CS_"
? ' CASE nCurrent =', TSTR( RECNO() - 1 )
? ' aClkBox[', TSTR( i ), ',6 ] = .F.'
ENDIF
i = i + 1
ENDSCAN
TEXT
ENDCASE
ENDIF
ENDIF
nLastKey = LASTKEY()
IF nLastKey = KB_ENTER
IF nDlgDef > 0
DO GetNext WITH nDlgDef
IF nCurrent = nDlgDef
DO TButton WITH BN_CLICKED, .F., nDlgDef
ENDIF
ENDIF
ENDIF
IF nPossNext > 0
IF nPossNext <> nCurrent
*-- User clicked to another field
DO GetNext WITH nPossNext
ELSE
nMess = 0
ENDIF
ELSE
DO CASE
CASE nMess = KB_TAB
DO GetNext WITH .T.
CASE nMess = KB_SHIFTTAB
DO GetNext WITH .F.
ENDCASE
ENDIF
CASE nMess = KB_MOUSE
nPossNext = GetMsTo()
IF nPossNext > 0
IF nPossNext <> nCurrent
*-- User clicked to another field
DO GetNext WITH nPossNext
ELSE
*-- User clicked inside of list box
DO TCombo WITH CBN_INLIST, .F., nCurrent
DO CASE
ENDTEXT
i = 1
SCAN FOR value_type = "B" .AND. LEFT( fieldname, 3 ) $ "CS_,LB_,UD_"
IF LEFT( fieldname, 3 ) = "CS_"
? ' CASE nCurrent =', TSTR( RECNO() - 1 )
? ' aClkBox[', TSTR( i ), ',6 ] = .F.'
ENDIF
i = i + 1
ENDSCAN
TEXT
ENDCASE
IF nMsEvent = KB_MOUSE
nPossNext = GetMsTo()
ELSE
IF nAccel > 0
DO GetNext WITH nAccel
RETURN
ELSE
nPossNext = 0
ENDIF
ENDIF
nLastKey = LASTKEY()
IF nLastKey = KB_ENTER
IF nDlgDef > 0
DO TButton WITH BN_CLICKED, .F., nDlgDef
RETURN
ENDIF
ENDIF
IF nPossNext > 0
IF nPossNext <> nCurrent
*-- User clicked to another field
DO GetNext WITH nPossNext
ELSE
nMess = 0
ENDIF
ELSE
DO CASE
CASE nMess = KB_TAB
DO GetNext WITH .T.
CASE nMess = KB_SHIFTTAB
DO GetNext WITH .F.
ENDCASE
ENDIF
ENDIF
ENDIF
CASE nMess = KB_CTRLW .AND. nAccel > 0
DO GetNext WITH nAccel
OTHERWISE
DO CkWaitAc
IF nAccel > 0
IF nAccel <> nCurrent
DO GetNext WITH nAccel
ENDIF
ENDIF
ENDCASE
RETURN
*-- EOP: DispCS
ENDTEXT
ENDIF
IF cd
TEXT
PROCEDURE DispCD
*----------------------------------------------------------------------------
* NAME
* DispCD -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
DO CASE
CASE nMess = KB_TAB
DO GetNext WITH .T.
CASE nMess = KB_SHIFTTAB
DO GetNext WITH .F.
CASE nMess = KB_MOUSE
nPossNext = GetMsTo()
IF nPossNext = nCurrent
nMess = KB_UPARROW
DO DispCD && Make a recursive call
ELSE
IF nPossNext > 0
DO GetNext WITH nPossNext
ENDIF
ENDIF
CASE nMess = KB_CTRLW .AND. nAccel > 0
DO GetNext WITH nAccel
CASE nMess = KB_ENTER
IF nDlgDef > 0
DO GetNext WITH nDlgDef
IF nCurrent = nDlgDef
DO TButton WITH BN_CLICKED, .F., nDlgDef
ENDIF
ENDIF
CASE nMess = KB_DOWNARROW .OR. ;
nMess = KB_UPARROW
DO TCombo WITH CBN_DROPDOW, .F., nCurrent
ENDTEXT
SET FILTER TO currentid > 1 .AND. ;
LEFT( fieldname, 3 ) = "CD_" .AND. ;
.NOT. ISBLANK( ok_cond )
GO TOP
IF .NOT. EOF()
TEXT
*-----------------------------------------------
*-- GENCODE - Do VALID code here from Memo field
*-----------------------------------------------
DO CASE
ENDTEXT
SCAN
cClass = LEFT( fieldname, 3 )
cField = TRIM( fieldname )
? ' CASE nCurrent =', TSTR( RECNO() )
?? "&"+"&" AT 41, cField
cOkCond = ok_cond
IF UPPER( LEFT( cOkCond, 3 ) ) = "DO("
*-- cDoExpr = '("TVDIAL")'
cDoExpr = SUBSTR( cOkCond, 3 )
? ' DO', &cDoExpr
ELSE
? ' IF', ok_cond
? ' ENDIF'
ENDIF
ENDSCAN
? ' ENDCASE'
ENDIF
SET FILTER TO
TEXT
IF nMsEvent = KB_MOUSE
nPossNext = GetMsTo()
IF nPossNext > 0
IF nPossNext <> nCurrent
*-- User clicked to another field
DO GetNext WITH nPossNext
ENDIF
ENDIF
ELSE
DO CASE
CASE nMess = KB_TAB
DO GetNext WITH .T.
CASE nMess = KB_SHIFTTAB
DO GetNext WITH .F.
CASE nAccel > 0
DO GetNext WITH nAccel
ENDCASE
ENDIF
OTHERWISE
DO CkWaitAc
IF nAccel > 0
IF nAccel <> nCurrent
DO GetNext WITH nAccel
ENDIF
ENDIF
ENDCASE
RETURN
*-- EOP: DispCD
ENDTEXT
ENDIF
IF cl
TEXT
PROCEDURE DispCL
*----------------------------------------------------------------------------
* NAME
* DispCL -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
PRIVATE nPossNext, lOkSelect
DO CASE
CASE nMess = KB_TAB
DO GetNext WITH .T.
CASE nMess = KB_SHIFTTAB
DO GetNext WITH .F.
CASE nMess = KB_MOUSE
nPossNext = GetMsTo()
IF nPossNext > 0
IF nPossNext = nCurrent
nMess = KB_MOUSE
ELSE
DO GetNext WITH nPossNext, .F.
ENDIF
ELSE
IF nMess <> DLN_CANCEL
nMess = 0
ENDIF
ENDIF
CASE nMess = KB_CTRLW .AND. nAccel > 0
DO GetNext WITH nAccel, .F.
CASE nMess = KB_ENTER
IF nDlgDef > 0
DO TButton WITH BN_CLICKED, .F., nDlgDef
ENDIF
CASE nMess = KB_DOWNARROW .OR. ;
nMess = KB_SPACE .OR. ;
nMess = KB_UPARROW
DO TCombo WITH CBN_DROPDOW, .F., nCurrent
ENDTEXT
SET FILTER TO currentid > 1 .AND. ;
LEFT( fieldname, 3 ) = "CL_" .AND. ;
.NOT. ISBLANK( ok_cond )
GO TOP
IF .NOT. EOF()
TEXT
*-------------------------------
*-- GENCODE - Do VALID code here
*-------------------------------
lOkSelect = .T.
DO CASE
ENDTEXT
SCAN
cClass = LEFT( fieldname, 3 )
cField = TRIM( fieldname )
? ' CASE nCurrent =', TSTR( RECNO() )
?? "&"+"&" AT 41, cField
cOkCond = ok_cond
IF UPPER( LEFT( cOkCond, 3 ) ) = "DO("
*-- cDoExpr = '("TVDIAL")'
cDoExpr = SUBSTR( cOkCond, 3 )
? ' DO', &cDoExpr
ELSE
? ' lOkSelect =', ok_cond
ENDIF
ENDSCAN
? ' ENDCASE'
? ' IF .NOT. lOkSelect'
? ' STORE 0 TO nMess, nMsEvent'
? ' ENDIF'
ENDIF
SET FILTER TO
TEXT
IF nMsEvent = KB_MOUSE
nPossNext = GetMsTo()
IF nPossNext > 0
IF nPossNext <> nCurrent
*-- User clicked to another field
DO GetNext WITH nPossNext, .F.
ENDIF
ENDIF
ELSE
DO CASE
CASE nMess = KB_TAB
DO GetNext WITH .T.
CASE nMess = KB_SHIFTTAB
DO GetNext WITH .F.
CASE nAccel > 0
DO GetNext WITH nAccel, .F.
ENDCASE
ENDIF
OTHERWISE
DO CkWaitAc
IF nAccel > 0
IF nAccel <> nCurrent
DO GetNext WITH nAccel, .F.
ENDIF
ENDIF
ENDCASE
RETURN
*-- EOP: DispCl
ENDTEXT
ENDIF && cl
RETURN
*-- EOP: GDisp
PROCEDURE GGetNext
*----------------------------------------------------------------------------
* NAME
* GGetNext -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
TEXT
PROCEDURE GetNext
PARAMETERS p__dir, pl_SameGrp
*----------------------------------------------------------------------------
* NAME
* GetNext -
*
* DESCRIPTION
*
* PARAMETERS
* p__dir = .T. to go forward, .F. to go back, number to go to
* record number.
* pl_SameGrp = .F. to go to first item in next/prev group, .T. will
* go to the next/prev item within the same group. Only
* applies to p__dir being next/previous.
*
*----------------------------------------------------------------------------
PRIVATE cPrevClass, nWay, npCurrent, nPointer, nNextObj, nNextPtr
PRIVATE nRecNo, npRecNo, lExit, cField, cVar, cCurrClass
ENDTEXT
SET FILTER TO .NOT. ( LEFT( fieldname, 3 ) $ "BT_,CK_,RB_" ) .AND. ;
.NOT. ISBLANK( ok_cond )
GO TOP
IF .NOT. EOF()
TEXT
*--------------------------------------------------------------
*-- Check for OK conditions, unless its a direct move to cancel
*--------------------------------------------------------------
IF ( TYPE( 'p__dir' ) = "N" .AND. p__dir <> nCancelBt ) .OR. ;
TYPE( 'p__dir' ) = "L"
ENDTEXT
? ' DO CASE'
SCAN
cClass = LEFT( fieldname, 3 )
cField = TRIM( fieldname )
? ' CASE nCurrent =', TSTR( RECNO() )
?? "&"+"&" AT 41, cField
cOkCond = ok_cond
? ' IF .NOT.', cOkCond
? ' RETURN'
? ' ENDIF'
ENDSCAN
? ' ENDCASE'
? ' ENDIF'
?
ENDIF
SET FILTER TO
TEXT
*------------------------------------------
*-- Check for move out of the current group
*------------------------------------------
IF .NOT. pl_SameGrp
IF TYPE( "p__dir" ) = "L"
DO HasTitle WITH nCurrent, BN_UNHILITE
ENDIF
ENDIF
ENDTEXT
IF nDlgDef > 0
? ' cPrevClass = LEFT( aClkObj[ aObjPoint[ nCurrent ], 11 ], 3 )'
?
ENDIF
IF rb .OR. ck
TEXT
*--------------------------------------------------
*-- Set the current CK or RB pointer before leaving
*--------------------------------------------------
ENDTEXT
? ' DO CASE'
SCAN FOR currentid > 0 .AND. LEFT( fieldname, 3 ) $ "RB_,CK_"
cClass = LEFT( fieldname, 3 )
cField = TRIM( fieldname )
? ' CASE nCurrent =', TSTR( RECNO() )
?? "&"+"&" AT 41, cField
cVar = "n" + LEFT( fieldname, RAT( "_", fieldname ) - 1 )
? ' STORE nCurrent TO', cVar
ENDSCAN
? ' ENDCASE'
ENDIF
TEXT
*----------------------------------------
*-- Handle the forward and backward moves
*----------------------------------------
IF TYPE( "p__dir" ) = "L"
DO CASE
ENDTEXT
IF rb .OR. ck .OR. ef
TEXT
*-------------------------------------------
*-- Go forward or backward in the same group
*-------------------------------------------
CASE pl_SameGrp
nWay = IIF( p__dir, 10, 9 ) && 10 Forward, 9 Back
npCurrent = aObjPoint[ nCurrent ]
nPointer = npCurrent
*-----------------------------------------------
*-- Is this a one item radio button or check box
*-----------------------------------------------
IF aClkObj[ npCurrent, 4 ] <> aClkObj[ npCurrent, nWay ]
DO WHILE .T.
*------------------------------------------------------
*-- Check to see if the next object's WHEN clause is Ok
*------------------------------------------------------
nNextObj = aClkObj[ nPointer, nWay ]
IF WhenOk( nNextObj )
nPointer = aObjPoint[ nNextObj ]
EXIT
ELSE
*-----------------------------------------------
*-- See if we looped back to the item we were on
*-----------------------------------------------
nNextPtr = aObjPoint[ nNextObj ]
IF nNextPtr = npCurrent
EXIT
ELSE
nPointer = nNextPtr
ENDIF
ENDIF
ENDDO
ENDIF
IF nPointer <> npCurrent
nCurrent = aClkObj[ nPointer, 4 ]
nCurrGrp = aClkObj[ nPointer, 5 ]
ENDIF
ENDTEXT
ENDIF
TEXT
OTHERWISE
nWay = IIF( p__dir, 6, 7 ) && 6 Forward, 7 Back
nRecNo = nCurrent
npRecNo = aObjPoint[ nRecNo ]
lExit = .F.
DO WHILE aClkObj[ npRecNo, 5 ] = nCurrGrp
nRecNo = aClkObj[ npRecNo, nWay ]
npRecNo = aObjPoint[ nRecNo ]
IF aClkObj[ npRecNo, 5 ] = nCurrGrp
LOOP
ELSE
*--------------------------------------------------
*-- Finally, we have moved out of the current group
*--------------------------------------------------
nCurrGrp = aClkObj[ npRecNo, 5 ]
IF .NOT. WhenOk( nRecNo )
LOOP
ELSE
nCurrent = nRecNo
lExit = .T.
ENDIF
ENDIF
ENDTEXT
IF ck .OR. rb
TEXT
*---------------------------------------------------------
*-- Was this a move into a radio button or check box group
*---------------------------------------------------------
cField = aClkObj[ npRecNo, 11 ]
cVar = "N" + LEFT( cField, RAT( "_", cField ) - 1 )
DO CASE
ENDTEXT
SET FILTER TO
SCAN FOR currentid > 0 .AND. ;
LEFT( fieldname, 3 ) $ "RB_,CK_" .AND. ;
RIGHT( TRIM( fieldname ), 2 ) = "_1"
cField = TRIM( fieldname )
cVar = "N" + LEFT( cField, RAT( "_", cField ) - 1 )
? ' CASE cVar = "' + cVar + '"'
? ' nRecNo =', cVar
? ' npRecNo = aObjPoint[ nRecNo ]'
? ' nCurrent = nRecNo'
? ' nCurrGrp = aClkObj[ npRecNo, 5 ]'
ENDSCAN
? ' ENDCASE'
ENDIF
TEXT
IF lExit
EXIT
ENDIF
ENDDO
DO HasTitle WITH nCurrent, BN_HILITE
ENDCASE
ELSE
*-------------------------------------------------------
*-- Handle direct moves to objects via Alt key and Mouse
*-------------------------------------------------------
IF .NOT. WhenOk( p__dir )
nMess = 0
RETURN
ENDIF
ENDTEXT
IF rb
TEXT
*--------------------------------------------------------------
*-- Check to see if we are leaving or going into a radio button
*-- group. If so, we may have to toggle off the current dot.
*--------------------------------------------------------------
DO CASE
*-----------------------------------------------------------
*-- If the current object is a radio button and the group to
*-- move into is the same, then...
*-----------------------------------------------------------
CASE LEFT( aClkObj[ aObjPoint[ nCurrent ], 11 ], 3 ) = "RB_" .AND. ;
aClkObj[ aObjPoint[ p__dir ], 5 ] = nCurrGrp
DO CASE
ENDTEXT
SCAN FOR currentid > 0 .AND. LEFT( fieldname, 3 ) = "RB_"
? ' CASE nCurrent =', TSTR( RECNO() )
? ' STORE .F. TO', TRIM( fieldname )
? ' DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent'
ENDSCAN
TEXT
ENDCASE
*---------------------------------------------
*-- If we are moving into a radio button group
*---------------------------------------------
CASE LEFT( aClkObj[ aObjPoint[ p__dir ], 11 ], 3 ) = "RB_"
DO CASE
ENDTEXT
SCAN FOR currentid > 0 .AND. LEFT( fieldname, 3 ) = "RB_"
? ' CASE p__dir =', TSTR( RECNO() )
cVar = "n" + LEFT( fieldname, RAT( "_", fieldname ) - 1 )
? ' IF p__dir <>', cvar
? ' cField = aClkObj[ aObjPoint[', cVar, '], 11 ]'
? ' STORE .F. TO &' + 'cField'
? ' DO TButton WITH WM_PAINT, BN_UNHILITE,', cVar
? ' ENDIF'
ENDSCAN
? ' ENDCASE'
?
? ' ENDCASE'
?
ENDIF && Rb
TEXT
IF nCurrGrp <> aClkObj[ aObjPoint[ p__dir ], 5 ]
DO HasTitle WITH nCurrent, BN_UNHILITE
DO HasTitle WITH p__dir, BN_HILITE
nCurrent = p__dir
nCurrGrp = aClkObj[ aObjPoint[ nCurrent ], 5 ]
ENDTEXT
SET FILTER TO currentid > 0 .AND. LEFT( fieldname, 3 ) = "BT_"
GO TOP
IF .NOT. EOF()
? ' DO CASE'
SCAN
? ' CASE nCurrent =', TSTR( RECNO() )
? ' DO TButton WITH BN_CLICKED, .F., nCurrent'
ENDSCAN
? ' ENDCASE'
ENDIF
SET FILTER TO
TEXT
ELSE
DO HasTitle WITH p__dir, BN_HILITE
ENDIF
nCurrent = p__dir
nCurrGrp = aClkObj[ aObjPoint[ nCurrent ], 5 ]
ENDIF
ENDTEXT
IF nDlgDef > 0
TEXT
*---------------------------------------------------------------
*-- Repaint the Default button if we were on a button before and
*-- the target is not a button.
*---------------------------------------------------------------
ENDTEXT
GOTO nDlgDef
? ' cCurrClass = LEFT( aClkObj[ aObjPoint[ nCurrent ], 11 ], 3 )'
? ' IF cPrevClass = "BT_" .AND. cCurrClass <> "BT_"'
? ' DO TButton WITH WM_PAINT, BN_DEFAULT, nDlgDef'
? ' STORE .T. TO', TRIM( fieldname )
? ' ENDIF'
ENDIF
IF rb .OR. ck
TEXT
*---------------------------------------------------------
*-- Save the current CK or RB pointer for the target group
*---------------------------------------------------------
ENDTEXT
? ' DO CASE'
SCAN FOR currentid > 0 .AND. LEFT( fieldname, 3 ) $ "RB_,CK_,BT_"
cClass = LEFT( fieldname, 3 )
cField = TRIM( fieldname )
? ' CASE nCurrent =', TSTR( RECNO() )
?? "&"+"&" AT 41, cField
cVar = "n" + LEFT( fieldname, RAT( "_", fieldname ) - 1 )
? ' STORE nCurrent TO', cVar
? ' IF TYPE( "p__dir" ) = "N"'
DO CASE
CASE cClass = "BT_"
? ' STORE .T. TO', cField
CASE cClass = "RB_"
? ' STORE .F. TO', cField
? ' DO TButton WITH BN_CLICKED, .F., nCurrent'
CASE cClass = "CK_"
? ' DO TButton WITH BN_CLICKED, .F., nCurrent'
ENDCASE
? ' ENDIF'
ENDSCAN
? ' ENDCASE'
ENDIF
TEXT
RETURN
*-- EOP: GetNext WITH p__dir, pl_SameGrp
ENDTEXT
RETURN
*-- EOP: GGetNext
PROCEDURE GWhenOk
*----------------------------------------------------------------------------
* NAME
* GWhenOk -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
TEXT
FUNCTION WhenOk
PARAMETERS pnTarget
*----------------------------------------------------------------------------
* NAME
* WhenOk - Validate the WHEN condition for a target object
*
* DESCRIPTION
*
* PARAMETERS
* pnTarget = Object ID to verify against
*
*----------------------------------------------------------------------------
PRIVATE lWhenOk
lWhenOk = .T.
ENDTEXT
SET FILTER TO currentid > 0 .AND. .NOT. ISBLANK( ed_cond )
GO TOP
IF .NOT. EOF()
? ' DO CASE'
SCAN
? ' CASE pnTarget =', TSTR( RECNO() )
?? "&"+"&" AT 41, TRIM( fieldname )
cWhen = ed_cond
cWhen = TRIM( cWhen )
? ' IF .NOT. (', cWhen, ')'
? ' lWhenOk = .F.'
? ' ENDIF'
ENDSCAN
SET FILTER TO
? ' ENDCASE'
ENDIF
TEXT
RETURN lWhenOk
*-- EOF: WhenOk( pnTarget )
ENDTEXT
RETURN
*-- EOP: GWhenOk
PROCEDURE GCkWaitAc
*----------------------------------------------------------------------------
* NAME
* GCkWaitAc -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
TEXT
PROCEDURE CkWaitAc
*----------------------------------------------------------------------------
* NAME
* CkWaitAc - Look for Accel key from Wait command
*
* DESCRIPTION
* This routine has high International risk for translations.
*----------------------------------------------------------------------------
IF nMess < 0
nAccPress = nMess + 500
ELSE
IF nMess >= 97 .AND. nMess <= 122
nMess = nMess - 32
ENDIF
nAccPress = nMess
ENDIF
DO CASE
ENDTEXT
SCAN FOR .NOT. ISBLANK( pickkey )
? ' CASE nAccPress =', TSTR( ASC( UPPER( pickkey ) ) )
?? '&'+'&' AT 41, pickkey, '-', TRIM( fieldname )
IF RIGHT( TRIM( fieldname ), 2 ) = "_0"
? ' nAccel =', TSTR( previd )
ELSE
? ' nAccel =', TSTR( currentid )
ENDIF
ENDSCAN
TEXT
OTHERWISE
nAccel = 0
ENDCASE
RETURN
*-- EOP: CkWaitAc
ENDTEXT
RETURN
*-- EOP: GCkWaitAc
FUNCTION TSTR
PARAMETERS pnString
*----------------------------------------------------------------------------
* NAME
* TSTR() - LTrim a number converted to a string.
*
* DESCRIPTION
* Convert to #define later on
*
* PARAMETERS
* pnString = Number to convert to a string
*
*----------------------------------------------------------------------------
RETURN LTRIM( STR( pnString ) )
*-- EOF: TSTR( pcString )
FUNCTION STR2QT
PARAMETERS pcStr
*----------------------------------------------------------------------------
* NAME
* STR2Qt() - Convert string value to a quoted output string
*
* DESCRIPTION
* Convert to #define later on
*
* PARAMETERS
* pcStr = String to check
*
*----------------------------------------------------------------------------
RETURN( '"' + pcStr + '"' )
*-- EOF: STR2Qt( pcStr )
PROCEDURE GGetMsTo
*----------------------------------------------------------------------------
* NAME
* GGetMsTo -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
TEXT
FUNCTION GetMsTo
PARAMETER plChkOnly
*----------------------------------------------------------------------------
* NAME
* GetMsTo() -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
*-- Check for a click on the close button
IF nMRow = nRowCls .AND. nMCol >= nLColCls .AND. nMCol <= nRColCls
nMess = DLN_CANCEL
nRtn = 0
ELSE
IF nMRow = nRowCls .AND. nMCol >= nCol .AND. nMCol <= nRWinCol
*---------------------------------------------------------
*-- All this to remove the shadow before moving the window
*---------------------------------------------------------
ENDTEXT
? ' SAVE WINDOW', pcDbfDial, 'TO _' + pcDbfDial
? ' RELEASE WINDOW', pcDbfDial
? ' RESTORE SCREEN FROM', pcDbfDial
? ' RESTORE WINDOW', pcDbfDial, 'FROM _' + pcDbfDial
? ' ERASE _' + pcDbfDial + '.win'
? ' ACTIVATE WINDOW', pcDbfDial
?
? ' @ 0, 0 TO nHigh - 1, nWidth - 1 COLOR', cClrWBt
? ' @ 0, 2 SAY "[ ]" COLOR', cClrWBt
? ' @ 0, 3 SAY CHR( 254 ) COLOR', cClrWBt
GO TOP
nOrigRow = row
SCAN FOR (value_type = "T" .AND. row = nOrigRow)
? ' @', TSTR( sys_flen ) + ', ' + TSTR( length ) + ' SAY '
?? '"' + TRIM( template ) + '" COLOR', cClrWBt
ENDSCAN
TEXT
*-------------------------------
*-- Start the move window action
*-------------------------------
nDelX = nMRow
nDelY = nMCol
SET CONSOLE OFF
WAIT
SET CONSOLE ON
nMRow = MROW()
nMCol = MCOL()
nDelX = nMRow - nDelX
nDelY = nMCol - nDelY
lMoveOk = .T.
ON ERROR lMoveOk = .F.
ENDTEXT
? ' MOVE WINDOW', pcDbfDial, 'BY nDelX, nDelY'
TEXT
ON ERROR
IF lMoveOk
nRowCls = nRowCls + nDelX
nCol = nCol + nDelY
nLColCls = ncol + 2 && Left column for close button
nRColCls = ncol + 4 && End column for close button
nRWinCol = ncol + nWidth - 1 && Rigth column for window
nXOffset = nRowCls - nOrigRow
nYOffset = nCol - nOrigCol
ENDIF
*---------------------------------------------------------
*-- Display the new shadow for after moving the dialog box
*---------------------------------------------------------
ENDTEXT
GO TOP
? ' SAVE WINDOW', pcDbfDial, 'TO _' + pcDbfDial
? ' RELEASE WINDOW', pcDbfDial
? ' RESTORE SCREEN FROM', pcDbfDial
? ' ACTIVATE SCREEN'
? ' IF nCol +', TSTR( length ), '< 80 .AND. nRowCls + '
?? TSTR( decimals ), '<= nScreen'
? ' @ nRowCls + 1, nCol + 1 FILL TO nRowCls + '
?? TSTR( decimals ) + ', nCol +', TSTR( length )
?? ' COLOR n+/n'
? ' ENDIF'
? ' RESTORE WINDOW', pcDbfDial, 'FROM _' + pcDbfDial
? ' ERASE _' + pcDbfDial + '.win'
? ' ACTIVATE WINDOW', pcDbfDial
?
? ' @ 0, 0 TO nHigh - 1, nWidth - 1 DOUBLE COLOR', cClrTit
? ' @ 0, 2 SAY "[ ]" COLOR', cClrTit
? ' @ 0, 3 SAY CHR( 254 ) COLOR', cClrWBt
nOrigRow = row
SCAN FOR ( value_type = "T" .AND. row = nOrigRow ) .OR. fieldname = "TI_TEXT"
IF fieldname = "TI_TEXT"
cMemvar = pic_choice
cMemcar = TRIM( cMemvar )
cMemvar = SUBSTR( cMemvar, 2, LEN( cMemvar ) - 2 )
? ' IF TYPE( "' + cMemvar + '" ) = "C"'
? " @", TSTR( sys_flen ) + ", " + TSTR( length ), ;
"SAY HelpCTit(",cMemvar+",",TSTR(LEN(TRIM(template)))+", .T. )", ;
"COLOR", cClrTit
? ' ELSE'
? " @", TSTR( sys_flen ) + ", " + TSTR( length ), ;
'SAY REPL( "*",', TSTR( LEN( TRIM( template ) ) ),;
') COLOR', cClrTit
? ' ENDIF'
ELSE
? ' @', TSTR( sys_flen ) + ', ' + TSTR( length ) + ' SAY '
?? '"' + TRIM( template ) + '" COLOR', cClrTit
ENDIF
ENDSCAN
TEXT
nRtn = -1
ELSE
*-----------------------------------
*-- Check for click on a live object
*-----------------------------------
nRtn = 0
i = 1
DO WHILE i <= nClkObj
IF nMRow = aClkObj[ i, 1 ] + nXOffSet .AND. ;
nMCol >= aClkObj[ i, 2 ] + nYOffset .AND. ;
nMCol <= aClkObj[ i, 3 ] + nYOffset
nRtn = aClkObj[ i, 4 ]
EXIT
ENDIF
i = i + 1
ENDDO
IF nRtn = 0
*----------------------------------------------------------
*-- Not found, check for a click in a Combo box or list box
*----------------------------------------------------------
IF nClkBox > 0
i = 1
DO WHILE i <= nClkBox
IF nMRow >= aClkBox[ i, 1 ] + nXOffset .AND. ;
nMRow <= aClkBox[ i, 1 ] + nXOffset + aClkBox[ i, 2 ] .AND. ;
nMCol >= aClkBox[ i, 3 ] + nYOffset .AND. ;
nMCol <= aClkBox[ i, 3 ] + nYOffset + aClkBox[ i, 4 ]
nRtn = aClkBox[ i, 5 ] - 1
aClkBox[ i, 6 ] = .T.
EXIT
ENDIF
i = i + 1
ENDDO
ENDIF
ENDIF
ENDIF
ENDIF
RETURN( nRtn )
*-- EOF: GetMsTo( )
ENDTEXT
RETURN
*-- EOP: GGetMsTo
PROCEDURE GMsHand
*----------------------------------------------------------------------------
* NAME
* GMsHand -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
TEXT
PROCEDURE MsHand
PARAMETERS pnMRow, pnMCol, pl_IsPop
*----------------------------------------------------------------------------
* NAME
* MsHand -
*
* DESCRIPTION
*
* PARAMETERS
* pnMRow =
* pnMCol =
* pl_IsPop =
*
*----------------------------------------------------------------------------
nMRow = pnMRow
nMCol = pnMCol
nMsEvent = KB_MOUSE
ENDTEXT
IF cd .OR. cs .OR. cl .OR. lb .OR. ud
? ' IF pl_IsPop'
? ' DO CASE'
SCAN FOR currentid > 0 .AND. LEFT( fieldname, 3 ) $ "CD_,CS_,CL_,LB_,UD_"
cField = TRIM( fieldname )
cVar = "n" + LEFT( cField, RAT( "_", cField ) - 1 )
? ' CASE nCurrent =', TSTR( RECNO() )
IF LEFT( fieldname, 3 ) <> "UD_"
? ' STORE BAR() TO', cVar
? ' SAVE SCREEN TO', cField
? ' KEYBOARD "{LeftArrow}"'
ELSE
cOkCond = ok_cond
cOkCond = TRIM( cOkCond )
IF .NOT. ISBLANK( cOkCond )
? ' IF', cOkCond
? ' ENDIF'
ENDIF
ENDIF
ENDSCAN
? ' ENDCASE'
? ' ELSE'
? ' KEYBOARD "{Ctrl-W}"'
? ' ENDIF'
ELSE
TEXT
KEYBOARD "{Ctrl-W}"
ENDTEXT
ENDIF
TEXT
RETURN
*-- EOP: MsHand WITH pnMRow, pnMCol, pl_IsPop
ENDTEXT
RETURN
*-- EOP: GMsHand
PROCEDURE GPostVals
*----------------------------------------------------------------------------
* NAME
* GPostVals -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
TEXT
PROCEDURE PostVals
*----------------------------------------------------------------------------
* NAME
* PostVals -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
ENDTEXT
? ' IF TYPE( "' + pcDbfDial + '[1]" ) <> "U"'
?
n = 1
SET FILTER TO
SET ORDER TO ObjOrder
SCAN FOR currentid > 0
cField = TRIM( fieldname )
cClass = LEFT( cField, 3 )
? ' ', pcDbfDial + '[', TSTR(n), '] =', cField
IF cClass = "LB_"
cVar = "n" + LEFT( cField, RAT( "_", cField ) - 1 )
? ' IF', cVar, '> 0'
? ' ', pcDbfDial + '[', TSTR(n), '] = '
?? 'BARPROMPT(', cVar + ', "' + cField + '")'
? ' ENDIF'
ENDIF
n = n + 1
ENDSCAN
TEXT
ENDIF
RETURN
*-- EOP: PostVals
ENDTEXT
RETURN
*-- EOP: GPostVals
PROCEDURE GTUser
*----------------------------------------------------------------------------
* NAME
* GTUser -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
TEXT
PROCEDURE TUser
PARAMETERS pn_msg, p__data, pnObject
*----------------------------------------------------------------------------
* NAME
* TUser -
*
* DESCRIPTION
*
* PARAMETERS
* pn_msg =
* p__data =
* pnObject =
*
*----------------------------------------------------------------------------
DO CASE
ENDTEXT
SCAN FOR currentid > 0 .AND. LEFT( fieldname, 3 ) $ "UD_"
cField = TRIM( fieldname )
cClass = LEFT( fieldname, 3 )
cPopChoice = pic_choice
cPopType = LEFT( UPPER( cPopChoice ), 4 )
cEdCond = ed_cond
cEdCond = TRIM( cEdCond )
cOkCond = ok_cond
cOkCond = TRIM( cOkCond )
cDefine = descript
cDefine = TRIM( cDefine )
? ' CASE pnObject =', TSTR( RECNO() )
? ' DO CASE'
? ' CASE pn_msg = WM_PAINT'
? ' DO CASE'
? ' CASE p__data = LBN_KILLFO'
? ' DO HasTitle WITH nCurrent, BN_UNHILITE'
? ' CASE p__data = WM_DRAWITEM'
? ' ', cDefine, 'NONE'
? ' ACTIVATE WINDOW', cField
IF .NOT. ISBLANK( cEdCond )
? ' IF', cEdCond
? ' ENDIF'
ENDIF
? ' SAVE SCREEN TO', cField
? ' DEACTIVATE WINDOW', cField
? ' RESTORE SCREEN FROM', cField
? ' RELEASE SCREEN', cField
? ' ACTIVATE WINDOW', pcDbfDial
? ' ENDCASE'
? ' CASE pn_msg = LBN_SETFOC'
? ' ', cDefine, 'NONE'
? ' ACTIVATE WINDOW', cField
IF .NOT. ISBLANK( cEdCond )
? ' IF', ed_cond
? ' ENDIF'
ENDIF
? ' SAVE SCREEN TO', cField
? ' DEACTIVATE WINDOW', cField
? ' RESTORE SCREEN FROM', cField
? ' RELEASE SCREEN', cField
? ' ACTIVATE WINDOW', pcDbfDial
? ' CASE pn_msg = LBN_SELCHA'
? ' *-- ON POPUP Handler here'
IF .NOT. ISBLANK( cOkCond )
? ' IF', cOkCond
? ' ENDIF'
?
ENDIF
? ' CASE pn_msg = LBN_DBLCLK'
? ' ENDCASE'
ENDSCAN
TEXT
ENDCASE
RETURN
*-- EOP: TUser WITH pn_msg, p__data, pnObject
ENDTEXT
RETURN
*-- EOP: GTUser
PROCEDURE GTList
*----------------------------------------------------------------------------
* NAME
* GTList -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
TEXT
PROCEDURE TList
PARAMETERS pn_msg, p__data, pnObject
*----------------------------------------------------------------------------
* NAME
* TList -
*
* DESCRIPTION
*
* PARAMETERS
* pn_msg =
* p__data =
* pnObject =
*
*----------------------------------------------------------------------------
IF TYPE( "cPopDef" ) <> "C"
cPopDef = ""
ENDIF
DO CASE
ENDTEXT
SCAN FOR currentid > 0 .AND. LEFT( fieldname, 3 ) $ "LB_,CS_,CD_,CL_"
cField = TRIM( fieldname )
cClass = LEFT( fieldname, 3 )
cPopChoice = pic_choice
cPopType = LEFT( UPPER( cPopChoice ), 4 )
cVar = "n" + LEFT( cField, RAT( "_", cField ) - 1 )
? ' CASE pnObject =', TSTR( RECNO() )
? ' DO CASE'
? ' CASE pn_msg = WM_PAINT'
? ' DO CASE'
? ' CASE p__data = LBN_KILLFO'
? ' DO HasTitle WITH nCurrent, BN_UNHILITE'
? ' CASE p__data = WM_DRAWITEM'
DO CASE
CASE cPopType = "FILE"
? ' SET COLOR OF MESS TO', cClrLbR
? ' SET COLOR OF TITLE TO', cClrLbR
nOpen = AT( "{", cPopChoice )
IF nopen > 0
nClose = AT( "}", cPopChoice )
cDepVar = SUBSTR( cPopChoice, nOpen+1, nClose-nOpen-1 )
cVarVal = cDepVar
ELSE
cVarVal = TRIM( cPopChoice )
cVarVal = SUBSTR( cVarVal, AT( "LIKE", cVarVal ) + 5 )
ENDIF
cDefine = descript
cDefine = TRIM( cDefine )
IF nopen > 0
? ' IF ISBLANK(', cVarVal, ')'
? ' ', cDefine, 'PROMPT FILES LIKE *.*'
? ' ELSE'
? ' ', cDefine, 'PROMPT FILES LIKE &' + cVarVal
? ' ENDIF'
ELSE
? ' ', cDefine, 'PROMPT FILES LIKE', cVarVal
ENDIF
? ' SHOW POPUP', cfield
CASE cPopType = "FIEL"
CASE cPopType = "STRU"
CASE LEFT(cPopType,3) = "DO "
cVarVal = SUBSTR( TRIM( cPopChoice ), 4 )
? ' lDoOk = .T.'
? ' ON ERROR lDoOk = .F.'
cDefine = descript
cDefine = TRIM( cDefine )
? ' ',cDefine
cNameLoc = SUBSTR( cDefine, AT( " ", cDefine, 2 ) + 1 )
? ' cPopDef =', '"' + cNameLoc + '"'
? ' DO', cVarVal
? ' ON ERROR'
? ' IF lDoOk'
? ' SHOW POPUP', cfield
? ' ELSE'
? ' DO _Err_Box WITH "Error with procedure file: " + '
?? Delimit( cVarVal )
? ' ENDIF'
OTHERWISE
? ' SET COLOR OF MESS TO', cClrLbR
? ' SET COLOR OF TITLE TO', cClrLbR
? ' *--------------------------------------------------'
? ' *-- Build the popup based on a comma delimited list'
? ' *--------------------------------------------------'
cDefine = descript
cDefine = TRIM( cDefine )
? ' ', cDefine
nItems = _WhatPara( "aChoice", cPopChoice )
n = 1
DO WHILE n <= nItems
? ' DEFINE BAR', TSTR( n ), 'OF', cField, 'PROMPT '
?? '"' + aChoice[n] + '"'
n = n + 1
ENDDO
? ' SHOW POPUP', cfield
RELEASE aChoice
ENDCASE
? ' ENDCASE'
? ' CASE pn_msg = LBN_SETFOC'
? ' SET COLOR OF MESS TO', cClrLbR
? ' SET COLOR OF TITLE TO', cClrLbR
TEXT
nMsEvent = 0
nMess = 0
nAccel = 0 && dBRIEF Tag...
pl_IsPop = .T.
ON MOUSE DO MsHand WITH MROW(), MCOL(), .T.
DO SetOnKey
ON KEY LABEL Tab DO TabOut WITH KB_TAB
ON KEY LABEL BackTab DO TabOut WITH KB_SHIFTTAB
lOk = .T.
ON ERROR lOk = .F.
ENDTEXT
? ' ON POPUP', cField, 'DO TList WITH LBN_SELCHA, .F., nCurrent'
TEXT
ON ERROR
IF .NOT. lOk
DO TList WITH WM_PAINT, WM_DRAWITEM, nCurrent
ENDTEXT
? ' ON POPUP', cField, 'DO TList WITH LBN_SELCHA, .F., nCurrent'
? ' ENDIF'
? ' ON SELECTION POPUP', cField, 'DO TList WITH LBN_DBLCLK, .F., nCurrent'
?
? ' *---------------------------------------------'
? ' *-- Keyboard to position bar at last selection'
? ' *---------------------------------------------'
IF cPopType = "FILE"
? ' IF .NOT. ISBLANK( CATALOG() )'
? ' n =', cVar, '- 2'
? ' ELSE'
? ' IF',cVar, '= 3'
? ' n = 0'
? ' ELSE'
? ' n = ', cVar, '- 3'
? ' ENDIF'
? ' ENDIF'
ELSE
? ' n =', cVar
ENDIF
? ' IF n > 0'
? ' i = 1'
? ' DO WHILE i < n'
? ' KEYBOARD [{DnArrow}]'
? ' i = i + 1'
? ' ENDDO'
? ' ENDIF'
?
? ' ACTIVATE POPUP', cField
TEXT
ON KEY LABEL Tab
ON KEY LABEL BackTab
DO ClrOnKey
ON MOUSE
pl_IsPop = .F.
ENDTEXT
? ' IF BAR() > 0'
? ' IF nMess <> DLN_OK'
? ' nMess = KB_ENTER'
? ' ENDIF'
? ' ON ERROR lOk = .F.'
? ' RESTORE SCREEN FROM', cField
? ' RELEASE SCREEN', cField
? ' ON ERROR'
? ' ELSE'
? ' IF nMess = 0'
? ' IF nMsEvent = KB_MOUSE'
? ' nMess = KB_MOUSE'
? ' RESTORE SCREEN FROM', cField
? ' RELEASE SCREEN', cField
? ' ELSE'
? ' nMess = LASTKEY()'
? ' ENDIF'
? ' ELSE'
? ' ON ERROR lOk = .F.'
? ' RESTORE SCREEN FROM', cField
? ' RELEASE SCREEN', cField
? ' ON ERROR'
? ' ENDIF'
? ' ENDIF'
? ' CASE pn_msg = LBN_SELCHA'
? ' *-- ON POPUP Handler here'
cOkCond = ok_cond
IF .NOT. ISBLANK( cOkCond )
? ' IF pnObject =', TSTR( RECNO() )
? ' IF', cOkCond
? ' ENDIF'
? ' ENDIF'
?
ENDIF
? ' CASE pn_msg = LBN_DBLCLK'
? ' SAVE SCREEN TO', cField
? ' STORE BAR() TO', cVar
IF .NOT. ISBLANK( cOkCond )
? ' IF pnObject =', TSTR( RECNO() )
? ' IF', cOkCond
? ' ENDIF'
? ' ENDIF'
?
ENDIF
? ' DEACTIVATE POPUP'
? ' ENDCASE'
ENDSCAN
TEXT
ENDCASE
RETURN
*-- EOP: TList WITH pn_msg, p__data, pnObject
ENDTEXT
RETURN
*-- EOP: GTList
PROCEDURE GTabOut
*----------------------------------------------------------------------------
* NAME
* GTabOut -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
TEXT
PROCEDURE TabOut
PARAMETERS pn_Key
*----------------------------------------------------------------------------
* NAME
* TabOut -
*
* DESCRIPTION
*
* PARAMETERS
* pn_Key =
*
*----------------------------------------------------------------------------
PRIVATE nRow, nCol, cPath, cPrompt, cDrive
nRow = ROW()
nCol = COL()
DO CASE
ENDTEXT
SCAN FOR currentid > 0 .AND. LEFT( fieldname, 3 ) $ "LB_,CS_,CD_,CL_,UD_"
cField = TRIM( fieldname )
cClass = LEFT( fieldname, 3 )
cPopChoice = pic_choice
cPopType = LEFT( UPPER( cPopChoice ), 4 )
cVar = "n" + LEFT( cField, RAT( "_", cField ) - 1 )
SET ORDER TO
SKIP
nPrompt = length - 2
SKIP -1
SET ORDER TO ObjOrder
? ' CASE nCurrent =', TSTR( RECNO() )
IF cClass <> "UD_"
? ' STORE BAR() TO', cVar
? ' *-- Redisplay the bar because of a "feature" in dBASE'
? ' cPrompt = TRIM( PROMPT() )'
ENDIF
DO CASE
CASE cPopType = "FILE"
? ' cDrive = _FileDrv( cPrompt )'
? ' IF .NOT. ISBLANK( cDrive )'
? ' cPath = cDrive + ":" + _FilePath( cPrompt )'
? ' ELSE'
? ' cPath = _FilePath( cPrompt )'
? ' ENDIF'
? ' cPrompt = TRIM( SUBSTR( cPrompt, LEN( cPath )+1 ) )'
? ' cPrompt = LEFT( cPrompt + SPACE(', TSTR( nPrompt )
?? ' ),', TSTR( nPrompt ), ')'
CASE cClass <> "UD_"
? ' cPrompt = LEFT( cPrompt + SPACE(', TSTR( nPrompt )
?? ' ),', TSTR( nPrompt ), ')'
CASE cClass = "UD_"
cOkCond = ok_cond
cOkCond = TRIM( cOkCond )
IF .NOT. ISBLANK( cOkCond )
? ' IF', cOkCond
? ' ENDIF'
ENDIF
ENDCASE
IF cClass <> "UD_"
? ' @ nRow, nCol SAY cPrompt COLOR', cClrLbH
? ' SAVE SCREEN TO', cField
? ' nMess = pn_Key'
? ' KEYBOARD "{LeftArrow}"'
ENDIF
ENDSCAN
TEXT
ENDCASE
RETURN
*-- EOP: TabOut WITH pn_Key
ENDTEXT
RETURN
*-- EOP: GTabOut
PROCEDURE GTCombo
*----------------------------------------------------------------------------
* NAME
* GTCombo -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
TEXT
PROCEDURE TCombo
PARAMETERS pn_msg, p__data, pnObject
*----------------------------------------------------------------------------
* NAME
* TCombo -
*
* DESCRIPTION
*
* PARAMETERS
* pn_msg =
* p__data =
* pnObject =
*
*----------------------------------------------------------------------------
PRIVATE cDisplay
DO CASE
ENDTEXT
SCAN FOR currentid > 0 .AND. LEFT( fieldname, 3 ) $ "CS_,CD_,CL_"
cField = TRIM( fieldname )
cClass = LEFT( fieldname, 3 )
cPopChoice = pic_choice
cPopType = LEFT( UPPER( cPopChoice ), 4 )
cVar = "n" + _Proper( LEFT( cField, RAT( "_", cField ) - 1 ) )
? ' CASE pnObject =', TSTR( RECNO() )
? ' DO CASE'
? ' CASE pn_msg = WM_PAINT'
? ' DO CASE'
? ' CASE p__data = CBN_KILLFOC'
? ' DO HasTitle WITH pnObject, BN_UNHILITE'
? ' CASE p__data = CB_HIDELST'
* ? ' RELEASE POPUP', cField
cTemplate = TRIM( template )
nIcon = AT( " [v]", cTemplate )
cIcon = CHR(222) + CHR(25) + CHR(221)
IF nIcon > 0
cPicture = "'" + SUBSTR( cTemplate, 1, nIcon - 1 ) + "'"
ELSE
cPicture = "'" + cTemplate + "'"
ENDIF
nLenCPic = LEN( cPicture )
? ' @', TSTR( sys_flen) + ', ' + TSTR( length ), 'GET '
?? cField, 'PICTURE', cPicture
IF nIcon > 0
? ' @', TSTR( sys_flen ) + ', ' + TSTR( length + nLenCPic - 2 )
?? ' SAY CHR(222) COLOR', cClrBtB
? ' @', TSTR( sys_flen ) + ', ' + TSTR( length + nLenCPic - 1 )
?? ' SAY CHR(25) COLOR', cClrBtI
? ' @', TSTR( sys_flen ) + ', ' + TSTR( length + nLenCPic )
?? ' SAY CHR(221) COLOR', cClrBtB
ENDIF
? ' CLEAR GETS'
? ' CASE p__data = CB_SHOWDRO'
? ' DO TList WITH WM_PAINT, WM_DRAWITEM, pnObject'
? ' ENDCASE'
? ' CASE pn_msg = CBN_DROPDOW'
? ' SAVE SCREEN TO Tcombo'
? ' DO TCombo WITH WM_PAINT, CB_SHOWDRO, pnObject'
? ' DO TCombo WITH CBN_INLIST, .F., pnObject'
? ' DO TCombo WITH WM_PAINT, CB_HIDELST, pnObject'
? ' RESTORE SCREEN FROM Tcombo'
? ' RELEASE SCREEN Tcombo'
cTemplate = TRIM( template )
nIcon = AT( " [v]", cTemplate )
cIcon = CHR(222) + CHR(25) + CHR(221)
IF nIcon > 0
cPicture = "'" + SUBSTR( cTemplate, 1, nIcon - 1 ) + "'"
ELSE
cPicture = "'" + cTemplate + "'"
ENDIF
? ' @', TSTR( sys_flen ) + ', ' + TSTR( length )
?? ' GET', cField, 'PICTURE', cPicture
? ' CLEAR GETS'
? ' CASE pn_msg = CB_SELECTS'
? ' *-----------------------------------------------------'
? ' *-- Do not repaint the get area during scroll re-entry'
? ' *-----------------------------------------------------'
? ' IF', cVar, '> 0'
? ' IF BAR() <>', cVar
? ' RETURN'
? ' ELSE'
? ' ', cVar, '= 0'
? ' ENDIF'
? ' ENDIF'
?
? ' IF TYPE( "p__data" ) = "L"'
? ' cPrompt = PROMPT()'
? ' ELSE'
? ' cPrompt = p__data'
? ' ENDIF'
cTemplate = TRIM( template )
nIcon = AT( " [v]", cTemplate )
cIcon = CHR(222) + CHR(25) + CHR(221)
IF nIcon > 0
cPicture = "'" + SUBSTR( cTemplate, 1, nIcon - 1 ) + "'"
ELSE
cPicture = "'" + cTemplate + "'"
ENDIF
nLen = IIF( pic_scroll > 0, pic_scroll, LEN( cTemplate ) )
IF cPopType = "FILE"
? ' cFileRoot = _FileRoot( cPrompt )'
? ' IF .NOT. "<" $ cFileRoot'
? ' STORE cFileRoot + "." + _FileType( cPrompt ) TO cDisplay'
? ' STORE LEFT(', 'cPrompt', '+ SPACE(', TSTR( nLen), '), '
?? TSTR( nLen), ') TO', cField
? ' STORE LEFT(', 'cDisplay', '+ SPACE(', TSTR( nLen), '), '
?? TSTR( nLen), ') TO cDisplay'
? ' @', TSTR( sys_flen ), ', ' + TSTR( length ), 'GET '
?? 'cDisplay', 'PICTURE', cPicture
? ' CLEAR GETS'
? ' ENDIF'
ELSE
? ' STORE cPrompt TO', cField
? ' STORE LEFT(', cField, '+ SPACE(', TSTR( nLen), '), '
?? TSTR( nLen), ') TO', cField
? ' @', TSTR( sys_flen ), ', ' + TSTR( length ), 'GET '
?? cField, 'PICTURE', cPicture
? ' CLEAR GETS'
ENDIF
? ' CASE pn_msg = CBN_INLIST'
? ' SET COLOR OF MESS TO', cClrLbR
? ' SET COLOR OF TITLE TO', cClrLbR
? ' nMsEvent = 0'
? ' nMess = 0'
? ' nAccel = 0'
? ' pl_IsPop = .T.'
? ' ON MOUSE DO MsHand WITH MROW(), MCOL(), .T.'
? ' DO SetOnKey'
? ' ON KEY LABEL Tab DO TabOut WITH KB_TAB'
? ' ON KEY LABEL BackTab DO TabOut WITH KB_SHIFTTAB'
? ' ON POPUP', cField, 'DO TCombo WITH CB_SELECTS, .F., pnObject'
? ' ON SELECTION POPUP', cField, 'DO TComboSel'
?
? ' *-------------------------------------------------'
? ' *-- Keyboard in down arrows to match prompt string'
? ' *-------------------------------------------------'
? ' IF', cVar, '> 0'
? ' n = 1'
? ' nHowMany =', cVar, '- 1'
IF cPopType = "FILE"
? ' IF ISBLANK( CATALOG() ) '
? ' nHowMany = nHowMany - 3'
? ' ELSE'
? ' nHowMany = nHowMany - 2'
? ' ENDIF'
ENDIF
? ' DO WHILE n <= nHowMany'
? ' KEYBOARD [{DnArrow}]'
? ' n = n + 1'
? ' ENDDO'
? ' ENDIF'
?
? ' ACTIVATE POPUP', cField
?
? ' pl_IsPop = .F.'
? ' ON KEY LABEL Tab'
? ' ON KEY LABEL BackTab'
? ' DO ClrOnKey'
? ' ON MOUSE'
?
? ' IF BAR() > 0'
IF cClass = "CS_"
? ' SHOW POPUP', cField
ENDIF
? ' nMess = KB_ENTER'
? ' ', cVar, '= BAR()'
? ' ELSE'
? ' IF nMess = 0'
? ' IF nMsEvent = KB_MOUSE'
? ' nMess = KB_MOUSE'
? ' RESTORE SCREEN FROM', cField
? ' RELEASE SCREEN', cField
? ' ELSE'
? ' nMess = LASTKEY()'
? ' ENDIF'
? ' ELSE'
? ' RESTORE SCREEN FROM', cField
? ' RELEASE SCREEN', cField
? ' ENDIF'
? ' ENDIF'
? ' ENDCASE'
ENDSCAN
TEXT
ENDCASE
RETURN
*-- EOP: TCombo WITH pn_msg, p__data, pnObject
PROCEDURE TComboSel
*----------------------------------------------------------------------------
* NAME
* TComboSel -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
DO TCombo WITH CB_SELECTS, .F., pnObject
DEACTIVATE POPUP
RETURN
*-- EOP: TComboSel
ENDTEXT
RETURN
*-- EOP: GTCombo
PROCEDURE GGetDDL
*----------------------------------------------------------------------------
* NAME
* GGetDDL -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
TEXT
PROCEDURE GetDDL
*----------------------------------------------------------------------------
* NAME
* GetDDL - Get Combo Box Drop Down List
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
lShowDrop = ( nAccel > 0 .OR. nMess = KB_MOUSE ) .AND. nMess <> KB_ENTER
DO CASE
ENDTEXT
SCAN FOR currentid > 0 .AND. LEFT( fieldname, 3 ) = "CL_"
cField = TRIM( fieldname )
? ' CASE nCurrent =', TSTR( RECNO() )
?? '&' + '&' AT 41, cField
? ' *-------------------------------------------------'
? ' *-- Look to see if the object in focus has a title'
? ' *-------------------------------------------------'
? ' DO HasTitle WITH nCurrent, BN_HILITE'
cTemplate = TRIM( template )
nIcon = AT( " [v]", cTemplate )
cIcon = CHR(222) + CHR(25) + CHR(221)
cPicture = "'" + SUBSTR( cTemplate, 1, nIcon - 1 ) + "'"
nLenCPic = LEN( cPicture )
? ' @', TSTR( sys_flen) + ', ' + TSTR( length ), 'GET '
?? cField, 'PICTURE', cPicture
IF nIcon > 0
? ' @', TSTR( sys_flen ) + ', ' + TSTR( length + nLenCPic - 2 )
?? ' SAY CHR(222) COLOR', cClrBtB
? ' @', TSTR( sys_flen ) + ', ' + TSTR( length + nLenCPic - 1 )
?? ' SAY CHR(25) COLOR', cClrBtI
? ' @', TSTR( sys_flen ) + ', ' + TSTR( length + nLenCPic )
?? ' SAY CHR(221) COLOR', cClrBtB
ENDIF
? ' CLEAR GETS'
ENDSCAN
TEXT
ENDCASE
IF lShowDrop
nMess = KB_SPACE
ELSE
SET CONSOLE OFF
SET CURSOR OFF
WAIT
SET CONSOLE ON
nMess = LASTKEY()
nMRow = MROW()
nMCol = MCOL()
ENDIF
RETURN
*-- EOP: GetDDL
ENDTEXT
RETURN
*-- EOP: GGetDDL
PROCEDURE GGetDD
*----------------------------------------------------------------------------
* NAME
* GGetDD -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
TEXT
PROCEDURE GetDD
*----------------------------------------------------------------------------
* NAME
* GetDD - Get Edit field for Combo Box Drop Down
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
nMess = 0
nAccel = 0
*-------------------------------------------------
*-- Look to see if the object in focus has a title
*-------------------------------------------------
DO HasTitle WITH nCurrent, BN_HILITE
nMsEvent = 0
ON MOUSE DO MsHand WITH MROW(), MCOL()
DO SetOnKey
DO CASE
ENDTEXT
SCAN FOR currentid > 0 .AND. LEFT( fieldname, 3 ) = "CD_"
cField = TRIM( fieldname )
? ' CASE nCurrent =', TSTR( RECNO() )
?? '&' + '&' AT 41, cField
cTemplate = TRIM( template )
nIcon = AT( " [v]", cTemplate )
cIcon = CHR(222) + CHR(25) + CHR(221)
IF pic_scroll > 0
cPicture = "'" + SUBSTR( cTemplate, 1, nIcon - 1 ) + "'"
nLenCPic = LEN( cPicture )
cPicture = "'@S" + TSTR(nLenCPic - 2) + "'"
ELSE
cPicture = "'" + SUBSTR( cTemplate, 1, nIcon - 1 ) + "'"
nLenCPic = LEN( cPicture )
ENDIF
? ' @', TSTR( sys_flen) + ', ' + TSTR( length ), 'GET '
?? cField, 'PICTURE', cPicture
IF nIcon > 0
? ' @', TSTR( sys_flen ) + ', ' + TSTR( length + nLenCPic - 2 )
?? ' SAY CHR(222) COLOR', cClrBtB
? ' @', TSTR( sys_flen ) + ', ' + TSTR( length + nLenCPic - 1 )
?? ' SAY CHR(25) COLOR', cClrBtI
? ' @', TSTR( sys_flen ) + ', ' + TSTR( length + nLenCPic )
?? ' SAY CHR(221) COLOR', cClrBtB
ENDIF
ENDSCAN
TEXT
ENDCASE
SET CURSOR ON
READ
SET CURSOR OFF
DO ClrOnKey
ON MOUSE
IF nMsEvent = KB_MOUSE
nMess = KB_MOUSE
ELSE
nMess = LASTKEY()
ENDIF
RETURN
*-- EOP: GetDD
ENDTEXT
RETURN
*-- EOP: GGetDD
PROCEDURE GGetId
*----------------------------------------------------------------------------
* NAME
* GGetId - Generate GetId()
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
TEXT
FUNCTION GetId
PARAMETERS pcVar
*----------------------------------------------------------------------------
* NAME
* GetId() - Search for memvar name and return current_id
*----------------------------------------------------------------------------
PRIVATE nId
nId = 0
DO CASE
ENDTEXT
GO TOP
SET ORDER TO
SET FILTER TO
SCAN FOR .NOT. (value_type $ "B,T" ) .AND. .NOT. ISBLANK( fieldname )
? ' CASE pcVar = "' + TRIM( fieldname ) + '"'
? ' nId =', TSTR( RECNO() )
ENDSCAN
? ' ENDCASE'
?
? 'RETURN( nId )'
? '*-- EOF: GetId( pcVar)'
?
RETURN
*-- EOP: GGetId
PROCEDURE GGenArray
*----------------------------------------------------------------------------
* NAME
* GGenArray -
*
* DESCRIPTION
*
*----------------------------------------------------------------------------
?
? 'PROCEDURE I' + pcDbfDial
TEXT
*----------------------------------------------------------------------------
* NAME
ENDTEXT
? '* I' + pcDbfDial, ' - Builds the Initialization array for this dialog box'
TEXT
*
* DESCRIPTION
ENDTEXT
? '* I' + pcDbfDial,'with create a routine that you can call or cut from this'
TEXT
* file to run a dialog box and capture the data on exit.
*
* To run the dialog box,
ENDTEXT
? '* SET PROCEDURE TO', pcDbfDial
? '* DO I' + pcDbfDial
? '* '
? '* Running I' + pcDbfDial,'with use the defaults from the SCR file. The'
TEXT
* array will remain in memory after execution.
*
* REMEMBER, REGENERATING THE DIALOG BOX WILL OVERWRITE THIS PROCEDURE!
*
*----------------------------------------------------------------------------
ENDTEXT
SET ORDER TO ObjOrder
SET FILTER TO currentid > 0
COUNT TO nItems
? ' PUBLIC ARRAY', pcDbfDial + '[', TSTR( nItems ), ']'
n = 1
SCAN
cField = TRIM( fieldname )
cClass = LEFT( cField, 3 )
cDefault = def_val
cDefault = UPPER( TRIM( cDefault ) )
lBlankDef = ISBLANK( cDefault )
? ' *--', cField, '-', TRIM( template )
? ' ', pcDbfDial + '[', TSTR( n ), ']', '= ' AT 21
IF .NOT. lBlankDef
Value = &cDefault
IF value_type = "C" .AND. .NOT. cClass $ "BT_,LB_,UD_"
nValue = LEN( Value )
IF pic_scroll > 0
nPadding = pic_scroll - nValue
ELSE
cTemplate = TRIM( template )
nLenTemp = LEN( cTemplate )
nPadding = nLenTemp - nValue
ENDIF
IF nPadding > 0
Value = Value + SPACE( nPadding )
ENDIF
cExp = cDefault + " + SPACE( " + LTRIM( STR( nPadding, 3 ) ) + " )"
ELSE
DO CASE
CASE value_type = "C" .AND. cClass = "BT_"
Value = &cDefault
IF Value = "DEFAULT"
cExp = ".T."
ELSE
cExp = ".F."
ENDIF
CASE value_type = "C" .AND. cClass $ "LB_,UD_"
cExp = "0"
OTHERWISE
cExp = cDefault
ENDCASE
ENDIF
ELSE
DO CASE
CASE value_type = "C" .AND. cClass = "BT_"
cExp = ".F."
CASE value_type = "C" .AND. cClass $ "LB_,UD_"
cExp = "0"
CASE value_type = "C" .AND. .NOT. cClass $ "BT_,LB_,UD_"
IF .NOT. ISBLANK( pic_choice )
cPopChoice = pic_choice
cPopChoice = TRIM( cPopChoice )
cPopType = LEFT( UPPER( cPopChoice ), 4 )
DO CASE
CASE cPopType = "FILE"
cExp = IIF( pic_scroll > 0, ;
"SPACE( " + LTRIM( STR( pic_scroll,3 ) ) + " )", ;
"SPACE( " + LTRIM( STR( LEN( TRIM( template ) ),3) ) + " )" )
CASE cPopType = "FIEL"
cExp = IIF( pic_scroll > 0, ;
"SPACE( " + LTRIM( STR( pic_scroll,3 ) ) + " )", ;
"SPACE( " + LTRIM( STR( LEN( TRIM( template ) ),3) ) + " )" )
CASE cPopType = "STRU"
cExp = IIF( pic_scroll > 0, ;
"SPACE( " + LTRIM( STR( pic_scroll,3 ) ) + " )", ;
"SPACE( " + LTRIM( STR( LEN( TRIM( template ) ),3) ) + " )" )
CASE LEFT(cPopType,3) = "DO "
cExp = IIF( pic_scroll > 0, ;
"SPACE( " + LTRIM( STR( pic_scroll,3 ) ) + " )", ;
"SPACE( " + LTRIM( STR( LEN( TRIM( template ) ),3) ) + " )" )
OTHERWISE
nComma = AT( ",", cPopChoice )
IF nComma > 0
Value = LEFT( cPopChoice, nComma - 1 )
ELSE
Value = cPopChoice
ENDIF
nValue = LEN( Value )
IF pic_scroll > 0
nPadding = pic_scroll - nValue
ELSE
cTemplate = TRIM( template )
nLenTemp = LEN( cTemplate )
nPadding = nLenTemp - nValue
ENDIF
IF nPadding > 0
cExp = "'"+Value+"'" + " + SPACE( " + LTRIM( STR( nPadding, 3 ) ) + " )"
ELSE
cExp = "'"+Value+"'"
ENDIF
ENDCASE
ELSE
cExp = IIF( pic_scroll > 0, ;
"SPACE( " + LTRIM( STR( pic_scroll,3 ) ) + " )", ;
"SPACE( " + LTRIM( STR( LEN( TRIM( template ) ),3) ) + " )" )
ENDIF
CASE value_type = "N"
cExp = 0
CASE value_type = "D"
cExp = "{ / / }"
CASE value_type = "L"
cExp = .F.
OTHERWISE
cExp = .F.
ENDCASE
ENDIF
?? cExp
?
n = n + 1
ENDSCAN
SET FILTER TO
TEXT
*--------------------------------------------------------------
*-- FXL_Cancel is set to .T. is the user Cancels the dialog box
*--------------------------------------------------------------
FXL_Cancel = .F.
*--------------------------------------------------------------
*-- FXL_NoChng lets the dialog box know that the values in the
*-- array are not different from the SCR file defaults. This
*-- will allow the dialog box to use the .WIN file for a faster
*-- startup.
*--------------------------------------------------------------
FXL_NoChng = .T.
ENDTEXT
? ' DO', pcDbfDial
TEXT
IF .NOT. FXL_Cancel && The user clicked on OK
*-----------------------------------
*-- Put your Ok processing code here
*-----------------------------------
ENDIF
ENDTEXT
? ' RELEASE', pcDbfDial && Release the array
?
? 'RETURN'
? '*-- EOP: I' + pcDbfDial
?
RETURN
*-- EOP: GGenArray
FUNCTION Delimit
PARAMETERS pcString
*----------------------------------------------------------------------------
* DESCRIPTION
*
* PARAMETERS
* pcString =
*
*----------------------------------------------------------------------------
IF ASC( pcString ) < 32
IF LEN( pcString ) = 1
lcResult = "CHR( " + ASC( pcString ) + " )"
ELSE
IF LEN( pcString ) = 0
lcResult = ""
ELSE
lcResult = "REPLICATE( CHR( " + ASC( pcString ) + " ), " + ;
STR( LEN( pcString ) ) + " )"
ENDIF
ENDIF
ELSE
cLeft= '"'
cRight = '"'
IF AT( '"', pcString ) > 0
IF AT( "'", pcString ) > 0
cLeft = "["
cRight = "]"
ELSE
cLeft = "'"
cRight = "'"
ENDIF
ENDIF
lcResult = cLeft + pcString + cRight
ENDIF
RETURN( lcResult )
*-- EOF: Delimit( pcString )
*'---------------------------------------------------------------------
*' $Log: C:/test/ccppdbb/prgs/gencode.prv $
*'
*' Rev 1.0 06 May 1993 8:14:14 Bill Ramos
*' Initial revision.
*
* Rev 1.1 13 Apr 1993 12:36:44 bramos
* update from bill for beta
*
* Rev 1.0 07 Apr 1993 17:43:58 chofmann
* Initial revision.
*'
*'---------------------------------------------------------------------
